[PATCH] add xl ocaml bindings

[PATCH] add xl ocaml bindings

[Vincent Hanquez]

Signed-off-by: Vincent Hanquez <vincent.hanquez@eu.citrix.com>
---
 tools/ocaml/Makefile           |    2 +-
 tools/ocaml/common.make        |    2 +-
 tools/ocaml/libs/xl/xl.ml      |  209 ++++++++++++
 tools/ocaml/libs/xl/xl.mli     |  209 ++++++++++++
 tools/ocaml/libs/xl/xl_stubs.c |  706 ++++++++++++++++++++++++++++++++++++++++
 5 files changed, 1126 insertions(+), 2 deletions(-)
 create mode 100644 tools/ocaml/libs/xl/xl.ml
 create mode 100644 tools/ocaml/libs/xl/xl.mli
 create mode 100644 tools/ocaml/libs/xl/xl_stubs.c

diff --git a/tools/ocaml/Makefile b/tools/ocaml/Makefile
index 2a36e7b..af5933b 100644
--- a/tools/ocaml/Makefile
+++ b/tools/ocaml/Makefile
@@ -4,7 +4,7 @@ include $(XEN_ROOT)/tools/Rules.mk
 SUBDIRS_LIBS = \
 	libs/uuid libs/mmap \
 	libs/log libs/xc libs/eventchn \
-	libs/xb libs/xs
+	libs/xb libs/xs libs/xl
 
 SUBDIRS_PROGRAMS = xenstored
 
diff --git a/tools/ocaml/common.make b/tools/ocaml/common.make
index 63b6b2e..a2085d7 100644
--- a/tools/ocaml/common.make
+++ b/tools/ocaml/common.make
@@ -9,7 +9,7 @@ OCAMLLEX ?= ocamllex
 OCAMLYACC ?= ocamlyacc
 
 CFLAGS += -fPIC -Werror
-CFLAGS += -I$(TOPLEVEL)/../include -I$(TOPLEVEL)/../libxc
+CFLAGS += -I$(TOPLEVEL)/../include -I$(TOPLEVEL)/../libxc -I$(TOPLEVEL)/../xenstore -I$(TOPLEVEL)/../libxl
 CFLAGS-$(CONFIG_Linux) += -I/usr/lib64/ocaml -I/usr/lib/ocaml
 CFLAGS-$(CONFIG_NetBSD) += -I/usr/pkg/lib/ocaml -fPIC
 
diff --git a/tools/ocaml/libs/xl/xl.ml b/tools/ocaml/libs/xl/xl.ml
new file mode 100644
index 0000000..0f665ae
--- /dev/null
+++ b/tools/ocaml/libs/xl/xl.ml
@@ -0,0 +1,209 @@
+(*
+ * Copyright (C) 2009-2010 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type create_info =
+{
+	hvm : bool;
+	hap : bool;
+	oos : bool;
+	ssidref : int32;
+	name : string;
+	uuid : int array;
+	xsdata : (string * string) list;
+	platformdata : (string * string) list;
+	poolid : int32;
+	poolname : string;
+}
+
+type build_pv_info =
+{
+	slack_memkb : int64;
+	cmdline : string;
+	ramdisk : string;
+	features : string;
+}
+
+type build_hvm_info =
+{
+	pae : bool;
+	apic : bool;
+	acpi : bool;
+	nx : bool;
+	viridian : bool;
+	timeoffset : string;
+}
+
+type build_spec = BuildHVM of build_hvm_info | BuildPV of build_pv_info
+
+type build_info =
+{
+	timer_mode : int;
+	hpet : int;
+	vpt_align : int;
+	max_vcpus : int;
+	cur_vcpus : int;
+	max_memkb : int64;
+	target_memkb : int64;
+	video_memkb : int64;
+	shadow_memkb : int64;
+	kernel : string;
+	priv: build_spec;
+}
+
+type build_state =
+{
+	store_port : int;
+	store_mfn : int64;
+	console_port : int;
+	console_mfn : int64;
+}
+
+type domid = int
+
+type disk_phystype =
+	| PHYSTYPE_QCOW
+	| PHYSTYPE_QCOW2
+	| PHYSTYPE_VHD
+	| PHYSTYPE_AIO
+	| PHYSTYPE_FILE
+	| PHYSTYPE_PHY
+
+type disk_info =
+{
+	backend_domid : domid;
+	physpath : string;
+	phystype : disk_phystype;
+	virtpath : string;
+	unpluggable : bool;
+	readwrite : bool;
+	is_cdrom : bool;
+}
+
+type nic_type =
+	| NICTYPE_IOEMU
+	| NICTYPE_VIF
+
+type nic_info =
+{
+	backend_domid : domid;
+	devid : int;
+	mtu : int;
+	model : string;
+	mac : int array;
+	bridge : string;
+	ifname : string;
+	script : string;
+	nictype : nic_type;
+}
+
+type console_type =
+	| CONSOLETYPE_XENCONSOLED
+	| CONSOLETYPE_IOEMU
+
+type console_info =
+{
+	backend_domid : domid;
+	devid : int;
+	consoletype : console_type;
+}
+
+type vkb_info =
+{
+	backend_domid : domid;
+	devid : int;
+}
+
+type vfb_info =
+{
+	backend_domid : domid;
+	devid : int;
+	vnc : bool;
+	vnclisten : string;
+	vncpasswd : string;
+	vncdisplay : int;
+	vncunused : bool;
+	keymap : string;
+	sdl : bool;
+	opengl : bool;
+	display : string;
+	xauthority : string;
+}
+
+type pci_info =
+{
+	v : int; (* domain * bus * dev * func multiplexed *)
+	domain : int;
+	vdevfn : int;
+	msitranslate : bool;
+	power_mgmt : bool;
+}
+
+type physinfo =
+{
+	threads_per_core: int;
+	cores_per_socket: int;
+	max_cpu_id: int;
+	nr_cpus: int;
+	cpu_khz: int;
+	total_pages: int64;
+	free_pages: int64;
+	scrub_pages: int64;
+	nr_nodes: int;
+	hwcap: int32 array;
+	physcap: int32;
+}
+
+type sched_credit =
+{
+	weight: int;
+	cap: int;
+}
+
+external domain_make : create_info -> domid = "stub_xl_domain_make"
+external domain_build : build_info -> domid -> build_state = "stub_xl_domain_build"
+
+external disk_add : disk_info -> domid -> unit = "stub_xl_disk_add"
+external disk_remove : disk_info -> domid -> unit = "stub_xl_disk_remove"
+
+external nic_add : nic_info -> domid -> unit = "stub_xl_nic_add"
+external nic_remove : disk_info -> domid -> unit = "stub_xl_nic_remove"
+
+external console_add : console_info -> build_state -> domid -> unit = "stub_xl_console_add"
+
+external vkb_add : vkb_info -> domid -> unit = "stub_xl_vkb_add"
+external vkb_clean_shutdown : domid -> unit = "stub_vkb_clean_shutdown"
+external vkb_hard_shutdown : domid -> unit = "stub_vkb_hard_shutdown"
+
+external vfb_add : vfb_info -> domid -> unit = "stub_xl_vfb_add"
+external vfb_clean_shutdown : domid -> unit = "stub_vfb_clean_shutdown"
+external vfb_hard_shutdown : domid -> unit = "stub_vfb_hard_shutdown"
+
+external pci_add : pci_info -> domid -> unit = "stub_xl_pci_add"
+external pci_remove : pci_info -> domid -> unit = "stub_xl_pci_remove"
+external pci_shutdown : domid -> unit = "stub_xl_pci_shutdown"
+
+type button =
+	| Button_Power
+	| Button_Sleep
+
+external button_press : domid -> button -> unit = "stub_xl_button_press"
+external physinfo : unit -> physinfo = "stub_xl_physinfo"
+
+external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get"
+external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set"
+
+external send_trigger : domid -> string -> 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"
diff --git a/tools/ocaml/libs/xl/xl.mli b/tools/ocaml/libs/xl/xl.mli
new file mode 100644
index 0000000..0f665ae
--- /dev/null
+++ b/tools/ocaml/libs/xl/xl.mli
@@ -0,0 +1,209 @@
+(*
+ * Copyright (C) 2009-2010 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *)
+
+type create_info =
+{
+	hvm : bool;
+	hap : bool;
+	oos : bool;
+	ssidref : int32;
+	name : string;
+	uuid : int array;
+	xsdata : (string * string) list;
+	platformdata : (string * string) list;
+	poolid : int32;
+	poolname : string;
+}
+
+type build_pv_info =
+{
+	slack_memkb : int64;
+	cmdline : string;
+	ramdisk : string;
+	features : string;
+}
+
+type build_hvm_info =
+{
+	pae : bool;
+	apic : bool;
+	acpi : bool;
+	nx : bool;
+	viridian : bool;
+	timeoffset : string;
+}
+
+type build_spec = BuildHVM of build_hvm_info | BuildPV of build_pv_info
+
+type build_info =
+{
+	timer_mode : int;
+	hpet : int;
+	vpt_align : int;
+	max_vcpus : int;
+	cur_vcpus : int;
+	max_memkb : int64;
+	target_memkb : int64;
+	video_memkb : int64;
+	shadow_memkb : int64;
+	kernel : string;
+	priv: build_spec;
+}
+
+type build_state =
+{
+	store_port : int;
+	store_mfn : int64;
+	console_port : int;
+	console_mfn : int64;
+}
+
+type domid = int
+
+type disk_phystype =
+	| PHYSTYPE_QCOW
+	| PHYSTYPE_QCOW2
+	| PHYSTYPE_VHD
+	| PHYSTYPE_AIO
+	| PHYSTYPE_FILE
+	| PHYSTYPE_PHY
+
+type disk_info =
+{
+	backend_domid : domid;
+	physpath : string;
+	phystype : disk_phystype;
+	virtpath : string;
+	unpluggable : bool;
+	readwrite : bool;
+	is_cdrom : bool;
+}
+
+type nic_type =
+	| NICTYPE_IOEMU
+	| NICTYPE_VIF
+
+type nic_info =
+{
+	backend_domid : domid;
+	devid : int;
+	mtu : int;
+	model : string;
+	mac : int array;
+	bridge : string;
+	ifname : string;
+	script : string;
+	nictype : nic_type;
+}
+
+type console_type =
+	| CONSOLETYPE_XENCONSOLED
+	| CONSOLETYPE_IOEMU
+
+type console_info =
+{
+	backend_domid : domid;
+	devid : int;
+	consoletype : console_type;
+}
+
+type vkb_info =
+{
+	backend_domid : domid;
+	devid : int;
+}
+
+type vfb_info =
+{
+	backend_domid : domid;
+	devid : int;
+	vnc : bool;
+	vnclisten : string;
+	vncpasswd : string;
+	vncdisplay : int;
+	vncunused : bool;
+	keymap : string;
+	sdl : bool;
+	opengl : bool;
+	display : string;
+	xauthority : string;
+}
+
+type pci_info =
+{
+	v : int; (* domain * bus * dev * func multiplexed *)
+	domain : int;
+	vdevfn : int;
+	msitranslate : bool;
+	power_mgmt : bool;
+}
+
+type physinfo =
+{
+	threads_per_core: int;
+	cores_per_socket: int;
+	max_cpu_id: int;
+	nr_cpus: int;
+	cpu_khz: int;
+	total_pages: int64;
+	free_pages: int64;
+	scrub_pages: int64;
+	nr_nodes: int;
+	hwcap: int32 array;
+	physcap: int32;
+}
+
+type sched_credit =
+{
+	weight: int;
+	cap: int;
+}
+
+external domain_make : create_info -> domid = "stub_xl_domain_make"
+external domain_build : build_info -> domid -> build_state = "stub_xl_domain_build"
+
+external disk_add : disk_info -> domid -> unit = "stub_xl_disk_add"
+external disk_remove : disk_info -> domid -> unit = "stub_xl_disk_remove"
+
+external nic_add : nic_info -> domid -> unit = "stub_xl_nic_add"
+external nic_remove : disk_info -> domid -> unit = "stub_xl_nic_remove"
+
+external console_add : console_info -> build_state -> domid -> unit = "stub_xl_console_add"
+
+external vkb_add : vkb_info -> domid -> unit = "stub_xl_vkb_add"
+external vkb_clean_shutdown : domid -> unit = "stub_vkb_clean_shutdown"
+external vkb_hard_shutdown : domid -> unit = "stub_vkb_hard_shutdown"
+
+external vfb_add : vfb_info -> domid -> unit = "stub_xl_vfb_add"
+external vfb_clean_shutdown : domid -> unit = "stub_vfb_clean_shutdown"
+external vfb_hard_shutdown : domid -> unit = "stub_vfb_hard_shutdown"
+
+external pci_add : pci_info -> domid -> unit = "stub_xl_pci_add"
+external pci_remove : pci_info -> domid -> unit = "stub_xl_pci_remove"
+external pci_shutdown : domid -> unit = "stub_xl_pci_shutdown"
+
+type button =
+	| Button_Power
+	| Button_Sleep
+
+external button_press : domid -> button -> unit = "stub_xl_button_press"
+external physinfo : unit -> physinfo = "stub_xl_physinfo"
+
+external domain_sched_credit_get : domid -> sched_credit = "stub_xl_sched_credit_domain_get"
+external domain_sched_credit_set : domid -> sched_credit -> unit = "stub_xl_sched_credit_domain_set"
+
+external send_trigger : domid -> string -> 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"
diff --git a/tools/ocaml/libs/xl/xl_stubs.c b/tools/ocaml/libs/xl/xl_stubs.c
new file mode 100644
index 0000000..4b351c2
--- /dev/null
+++ b/tools/ocaml/libs/xl/xl_stubs.c
@@ -0,0 +1,706 @@
+/*
+ * Copyright (C) 2009-2010 Citrix Ltd.
+ * Author Vincent Hanquez <vincent.hanquez@eu.citrix.com>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published
+ * by the Free Software Foundation; version 2.1 only. with the special
+ * exception on linking described in file LICENSE.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ */
+
+#include <stdlib.h>
+
+#define CAML_NAME_SPACE
+#include <caml/alloc.h>
+#include <caml/memory.h>
+#include <caml/signals.h>
+#include <caml/fail.h>
+#include <caml/callback.h>
+
+#include <sys/mman.h>
+#include <stdint.h>
+#include <string.h>
+
+#include "libxl.h"
+
+#define INIT_CTX()  \
+	ret = libxl_ctx_init(&ctx, LIBXL_VERSION, NULL); \
+	if (ret != 0) \
+		failwith_xl("cannot init context");
+
+#define FREE_CTX()  \
+	libxl_ctx_free(&ctx)
+
+void log_callback(void *userdata, int loglevel, const char *file,
+		int line, const char *func, char *s)
+{
+}
+
+void failwith_xl(char *log_data)
+{
+	char s[1024];
+	snprintf(s, 1024, "proper logging not implemented yet: error in %s", log_data);
+	caml_raise_with_string(*caml_named_value("xl.error"), log_data);
+}
+
+static int string_string_tuple_array_val (char ***c_val, value v)
+{
+	CAMLparam1(v);
+	CAMLlocal1(a);
+	int i;
+	char **array;
+
+	for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1)) { i++; }
+
+	array = calloc((i + 1) * 2, sizeof(char *));
+	if (!array)
+		return 1;
+	for (i = 0, a = Field(v, 5); a != Val_emptylist; a = Field(a, 1), i++) {
+		value b = Field(a, 0);
+		array[i * 2] = String_val(Field(b, 0));
+		array[i * 2 + 1] = String_val(Field(b, 1));
+	}
+	*c_val = array;
+	CAMLreturn(0);
+}
+
+static int domain_create_info_val (libxl_domain_create_info *c_val, value v)
+{
+	CAMLparam1(v);
+	CAMLlocal1(a);
+	int i;
+
+	c_val->hvm = Bool_val(Field(v, 0));
+	c_val->hap = Bool_val(Field(v, 1));
+	c_val->oos = Bool_val(Field(v, 2));
+	c_val->ssidref = Int32_val(Field(v, 3));
+	c_val->name = String_val(Field(v, 4));
+	a = Field(v, 5);
+	for (i = 0; i < 16; i++)
+		c_val->uuid[i] = Int_val(Field(a, i));
+	string_string_tuple_array_val(&(c_val->xsdata), Field(v, 6));
+	string_string_tuple_array_val(&(c_val->platformdata), Field(v, 7));
+
+	c_val->poolid = Int32_val(Field(v, 8));
+	c_val->poolname = String_val(Field(v, 9));
+
+	CAMLreturn(0);
+}
+
+static int domain_build_info_val (libxl_domain_build_info *c_val, value v)
+{
+	CAMLparam1(v);
+	CAMLlocal1(infopriv);
+
+	c_val->timer_mode = Int_val(Field(v, 0));
+	c_val->hpet = Int_val(Field(v, 1));
+	c_val->vpt_align = Int_val(Field(v, 2));
+	c_val->max_vcpus = Int_val(Field(v, 3));
+	c_val->cur_vcpus = Int_val(Field(v, 4));
+	c_val->max_memkb = Int64_val(Field(v, 5));
+	c_val->target_memkb = Int64_val(Field(v, 6));
+	c_val->video_memkb = Int64_val(Field(v, 7));
+	c_val->shadow_memkb = Int64_val(Field(v, 8));
+	c_val->kernel = String_val(Field(v, 9));
+	c_val->hvm = Tag_val(Field(v, 10)) == 0;
+	infopriv = Field(Field(v, 10), 0);
+	if (c_val->hvm) {
+		c_val->u.hvm.pae = Bool_val(Field(infopriv, 0));
+		c_val->u.hvm.apic = Bool_val(Field(infopriv, 1));
+		c_val->u.hvm.acpi = Bool_val(Field(infopriv, 2));
+		c_val->u.hvm.nx = Bool_val(Field(infopriv, 3));
+		c_val->u.hvm.viridian = Bool_val(Field(infopriv, 4));
+		c_val->u.hvm.timeoffset = String_val(Field(infopriv, 5));
+	} else {
+		c_val->u.pv.slack_memkb = Int64_val(Field(infopriv, 0));
+		c_val->u.pv.cmdline = String_val(Field(infopriv, 1));
+		c_val->u.pv.ramdisk = String_val(Field(infopriv, 2));
+		c_val->u.pv.features = String_val(Field(infopriv, 3));
+	}
+
+	CAMLreturn(0);
+}
+
+static int device_disk_val(libxl_device_disk *c_val, value v)
+{
+	CAMLparam1(v);
+
+	c_val->backend_domid = Int_val(Field(v, 0));
+	c_val->physpath = String_val(Field(v, 1));
+	c_val->phystype = (Int_val(Field(v, 2))) + PHYSTYPE_QCOW;
+	c_val->virtpath = String_val(Field(v, 3));
+	c_val->unpluggable = Bool_val(Field(v, 4));
+	c_val->readwrite = Bool_val(Field(v, 5));
+	c_val->is_cdrom = Bool_val(Field(v, 6));
+
+	CAMLreturn(0);
+}
+
+static int device_nic_val(libxl_device_nic *c_val, value v)
+{
+	CAMLparam1(v);
+	int i;
+	int ret = 0;
+	c_val->backend_domid = Int_val(Field(v, 0));
+	c_val->devid = Int_val(Field(v, 1));
+	c_val->mtu = Int_val(Field(v, 2));
+	c_val->model = String_val(Field(v, 3));
+
+	if (Wosize_val(Field(v, 4)) != 6) {
+		ret = 1;
+		goto out;
+	}
+	for (i = 0; i < 6; i++)
+		c_val->mac[i] = Int_val(Field(Field(v, 4), i));
+
+	/* not handling c_val->ip */
+	c_val->bridge = String_val(Field(v, 5));
+	c_val->ifname = String_val(Field(v, 6));
+	c_val->script = String_val(Field(v, 7));
+	c_val->nictype = (Int_val(Field(v, 8))) + NICTYPE_IOEMU;
+
+out:
+	CAMLreturn(ret);
+}
+
+static int device_console_val(libxl_device_console *c_val, value v)
+{
+	CAMLparam1(v);
+
+	c_val->backend_domid = Int_val(Field(v, 0));
+	c_val->devid = Int_val(Field(v, 1));
+	c_val->constype = (Int_val(Field(v, 2))) + CONSTYPE_XENCONSOLED;
+
+	CAMLreturn(0);
+}
+
+static int device_vkb_val(libxl_device_vkb *c_val, value v)
+{
+	CAMLparam1(v);
+
+	c_val->backend_domid = Int_val(Field(v, 0));
+	c_val->devid = Int_val(Field(v, 1));
+
+	CAMLreturn(0);
+}
+
+static int device_vfb_val(libxl_device_vfb *c_val, value v)
+{
+	CAMLparam1(v);
+
+	c_val->backend_domid = Int_val(Field(v, 0));
+	c_val->devid = Int_val(Field(v, 1));
+	c_val->vnc = Bool_val(Field(v, 2));
+	c_val->vnclisten = String_val(Field(v, 3));
+	c_val->vncpasswd = String_val(Field(v, 4));
+	c_val->vncdisplay = Int_val(Field(v, 5));
+	c_val->keymap = String_val(Field(v, 6));
+	c_val->sdl = Bool_val(Field(v, 7));
+	c_val->opengl = Bool_val(Field(v, 8));
+	c_val->display = String_val(Field(v, 9));
+	c_val->xauthority = String_val(Field(v, 10));
+
+	CAMLreturn(0);
+}
+
+static int device_pci_val(libxl_device_pci *c_val, value v)
+{
+	CAMLparam1(v);
+
+	c_val->value = Int_val(Field(v, 0));
+	c_val->domain = Int_val(Field(v, 1));
+	c_val->vdevfn = Int_val(Field(v, 2));
+	c_val->msitranslate = Bool_val(Field(v, 3));
+	c_val->power_mgmt = Bool_val(Field(v, 4));
+
+	CAMLreturn(0);
+}
+
+static int sched_credit_val(struct libxl_sched_credit *c_val, value v)
+{
+	CAMLparam1(v);
+	c_val->weight = Int_val(Field(v, 0));
+	c_val->cap = Int_val(Field(v, 1));
+	CAMLreturn(0);
+}
+
+static int domain_build_state_val(libxl_domain_build_state *c_val, value v)
+{
+	CAMLparam1(v);
+
+	c_val->store_port = Int_val(Field(v, 0));
+	c_val->store_mfn = Int64_val(Field(v, 1));
+	c_val->console_port = Int_val(Field(v, 2));
+	c_val->console_mfn = Int64_val(Field(v, 3));
+	
+	CAMLreturn(0);
+}
+
+static value Val_sched_credit(struct libxl_sched_credit *c_val)
+{
+	CAMLparam0();
+	CAMLlocal1(v);
+
+	v = caml_alloc_tuple(2);
+
+	Store_field(v, 0, Val_int(c_val->weight));
+	Store_field(v, 1, Val_int(c_val->cap));
+
+	CAMLreturn(v);
+}
+
+static value Val_domain_build_state(libxl_domain_build_state *c_val)
+{
+	CAMLparam0();
+	CAMLlocal1(v);
+
+	v = caml_alloc_tuple(4);
+
+	Store_field(v, 0, Val_int(c_val->store_port));
+	Store_field(v, 1, caml_copy_int64(c_val->store_mfn));
+	Store_field(v, 2, Val_int(c_val->console_port));
+	Store_field(v, 3, caml_copy_int64(c_val->console_mfn));
+
+	CAMLreturn(v);
+}
+
+static value Val_physinfo(struct libxl_physinfo *c_val)
+{
+	CAMLparam0();
+	CAMLlocal2(v, hwcap);
+	int i;
+
+	hwcap = caml_alloc_tuple(8);
+	for (i = 0; i < 8; i++)
+		Store_field(hwcap, i, caml_copy_int32(c_val->hw_cap[i]));
+
+	v = caml_alloc_tuple(11);
+	Store_field(v, 0, Val_int(c_val->threads_per_core));
+	Store_field(v, 1, Val_int(c_val->cores_per_socket));
+	Store_field(v, 2, Val_int(c_val->max_cpu_id));
+	Store_field(v, 3, Val_int(c_val->nr_cpus));
+	Store_field(v, 4, Val_int(c_val->cpu_khz));
+	Store_field(v, 5, caml_copy_int64(c_val->total_pages));
+	Store_field(v, 6, caml_copy_int64(c_val->free_pages));
+	Store_field(v, 7, caml_copy_int64(c_val->scrub_pages));
+	Store_field(v, 8, Val_int(c_val->nr_nodes));
+	Store_field(v, 9, hwcap);
+	Store_field(v, 10, caml_copy_int32(c_val->phys_cap));
+
+	CAMLreturn(v);
+}
+
+value stub_xl_domain_make(value info)
+{
+	CAMLparam1(info);
+	struct libxl_ctx ctx;
+	uint32_t domid;
+	libxl_domain_create_info c_info;
+	int ret;
+
+	domain_create_info_val (&c_info, info);
+
+	INIT_CTX();
+
+	ret = libxl_domain_make(&ctx, &c_info, &domid);
+	if (ret != 0)
+		failwith_xl("domain make");
+
+	FREE_CTX();
+
+	free(c_info.xsdata);
+	free(c_info.platformdata);
+
+	CAMLreturn(Val_int(domid));
+}
+
+value stub_xl_domain_build(value info, value domid)
+{
+	CAMLparam2(info, domid);
+	CAMLlocal1(result);
+	struct libxl_ctx ctx;
+	libxl_domain_build_info c_info;
+	libxl_domain_build_state c_state;
+	int ret;
+	int c_domid;
+
+	domain_build_info_val (&c_info, info);
+	c_domid = Int_val(domid);
+
+	INIT_CTX();
+
+	ret = libxl_domain_build(&ctx, &c_info, c_domid, &c_state);
+	if (ret != 0)
+		failwith_xl("domain_build");
+
+	result = Val_domain_build_state(&c_state);
+	FREE_CTX();
+
+	CAMLreturn(result);
+}
+
+value stub_xl_disk_add(value info, value domid)
+{
+	CAMLparam2(info, domid);
+	libxl_device_disk c_info;
+	struct libxl_ctx ctx;
+	int ret;
+
+	device_disk_val(&c_info, info);
+	c_info.domid = Int_val(domid);
+
+	INIT_CTX();
+	ret = libxl_device_disk_add(&ctx, Int_val(domid), &c_info);
+	if (ret != 0)
+		failwith_xl("disk_add");
+	FREE_CTX();
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_disk_remove(value info, value domid)
+{
+	CAMLparam2(info, domid);
+	libxl_device_disk c_info;
+	struct libxl_ctx ctx;
+	int ret;
+
+	device_disk_val(&c_info, info);
+	c_info.domid = Int_val(domid);
+
+	INIT_CTX();
+	ret = libxl_device_disk_del(&ctx, &c_info, 0);
+	if (ret != 0)
+		failwith_xl("disk_remove");
+	FREE_CTX();
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_nic_add(value info, value domid)
+{
+	CAMLparam2(info, domid);
+	struct libxl_ctx ctx;
+	libxl_device_nic c_info;
+	int ret;
+
+	device_nic_val(&c_info, info);
+	c_info.domid = Int_val(domid);
+
+	INIT_CTX();
+	ret = libxl_device_nic_add(&ctx, Int_val(domid), &c_info);
+	if (ret != 0)
+		failwith_xl("nic_add");
+	FREE_CTX();
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_nic_remove(value info, value domid)
+{
+	CAMLparam2(info, domid);
+	struct libxl_ctx ctx;
+	libxl_device_nic c_info;
+	int ret;
+
+	device_nic_val(&c_info, info);
+	c_info.domid = Int_val(domid);
+
+	INIT_CTX();
+	ret = libxl_device_nic_del(&ctx, &c_info, 0);
+	if (ret != 0)
+		failwith_xl("nic_remove");
+	FREE_CTX();
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_console_add(value info, value state, value domid)
+{
+	CAMLparam3(info, state, domid);
+	struct libxl_ctx ctx;
+	libxl_device_console c_info;
+	libxl_domain_build_state c_state;
+	int ret;
+
+	device_console_val(&c_info, info);
+	domain_build_state_val(&c_state, state);
+	c_info.domid = Int_val(domid);
+	c_info.build_state = &c_state;
+
+	INIT_CTX();
+	ret = libxl_device_console_add(&ctx, Int_val(domid), &c_info);
+	if (ret != 0)
+		failwith_xl("console_add");
+	FREE_CTX();
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_vkb_add(value info, value domid)
+{
+	CAMLparam2(info, domid);
+	struct libxl_ctx ctx;
+	libxl_device_vkb c_info;
+	int ret;
+
+	device_vkb_val(&c_info, info);
+	c_info.domid = Int_val(domid);
+
+	INIT_CTX();
+	ret = libxl_device_vkb_add(&ctx, Int_val(domid), &c_info);
+	if (ret != 0)
+		failwith_xl("vkb_add");
+	FREE_CTX();
+	
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_vkb_clean_shutdown(value domid)
+{
+	CAMLparam1(domid);
+	struct libxl_ctx ctx;
+	int ret;
+
+	INIT_CTX();
+	ret = libxl_device_vkb_clean_shutdown(&ctx, Int_val(domid));
+	if (ret != 0)
+		failwith_xl("vkb_clean_shutdown");
+	FREE_CTX();
+	
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_vkb_hard_shutdown(value domid)
+{
+	CAMLparam1(domid);
+	struct libxl_ctx ctx;
+	int ret;
+
+	INIT_CTX();
+	ret = libxl_device_vkb_hard_shutdown(&ctx, Int_val(domid));
+	if (ret != 0)
+		failwith_xl("vkb_hard_shutdown");
+	FREE_CTX();
+	
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_vfb_add(value info, value domid)
+{
+	CAMLparam2(info, domid);
+	struct libxl_ctx ctx;
+	libxl_device_vfb c_info;
+	int ret;
+
+	device_vfb_val(&c_info, info);
+	c_info.domid = Int_val(domid);
+
+	INIT_CTX();
+	ret = libxl_device_vfb_add(&ctx, Int_val(domid), &c_info);
+	if (ret != 0)
+		failwith_xl("vfb_add");
+	FREE_CTX();
+	
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_vfb_clean_shutdown(value domid)
+{
+	CAMLparam1(domid);
+	struct libxl_ctx ctx;
+	int ret;
+
+	INIT_CTX();
+	ret = libxl_device_vfb_clean_shutdown(&ctx, Int_val(domid));
+	if (ret != 0)
+		failwith_xl("vfb_clean_shutdown");
+	FREE_CTX();
+	
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_vfb_hard_shutdown(value domid)
+{
+	CAMLparam1(domid);
+	struct libxl_ctx ctx;
+	int ret;
+
+	INIT_CTX();
+	ret = libxl_device_vfb_hard_shutdown(&ctx, Int_val(domid));
+	if (ret != 0)
+		failwith_xl("vfb_hard_shutdown");
+	FREE_CTX();
+	
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_pci_add(value info, value domid)
+{
+	CAMLparam2(info, domid);
+	struct libxl_ctx ctx;
+	libxl_device_pci c_info;
+	int ret;
+
+	device_pci_val(&c_info, info);
+
+	INIT_CTX();
+	ret = libxl_device_pci_add(&ctx, Int_val(domid), &c_info);
+	if (ret != 0)
+		failwith_xl("pci_add");
+	FREE_CTX();
+	
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_pci_remove(value info, value domid)
+{
+	CAMLparam2(info, domid);
+	struct libxl_ctx ctx;
+	libxl_device_pci c_info;
+	int ret;
+
+	device_pci_val(&c_info, info);
+
+	INIT_CTX();
+	ret = libxl_device_pci_remove(&ctx, Int_val(domid), &c_info);
+	if (ret != 0)
+		failwith_xl("pci_remove");
+	FREE_CTX();
+	
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_pci_shutdown(value domid)
+{
+	CAMLparam1(domid);
+	struct libxl_ctx ctx;
+	int ret;
+
+	INIT_CTX();
+	ret = libxl_device_pci_shutdown(&ctx, Int_val(domid));
+	if (ret != 0)
+		failwith_xl("pci_shutdown");
+	FREE_CTX();
+	
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_button_press(value domid, value button)
+{
+	CAMLparam2(domid, button);
+	struct libxl_ctx ctx;
+	int ret;
+	
+	INIT_CTX();
+	ret = libxl_button_press(&ctx, Int_val(domid), Int_val(button) + POWER_BUTTON);
+	if (ret != 0)
+		failwith_xl("button_press");
+	FREE_CTX();
+
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_physinfo(value unit)
+{
+	CAMLparam1(unit);
+	CAMLlocal1(physinfo);
+	struct libxl_ctx ctx;
+	struct libxl_physinfo c_physinfo;
+	int ret;
+
+	INIT_CTX();
+	ret = libxl_get_physinfo(&ctx, &c_physinfo);
+	if (ret != 0)
+		failwith_xl("physinfo");
+	FREE_CTX();
+	
+	physinfo = Val_physinfo(&c_physinfo);
+	CAMLreturn(physinfo);
+}
+
+value stub_xl_sched_credit_domain_get(value domid)
+{
+	CAMLparam1(domid);
+	CAMLlocal1(scinfo);
+	struct libxl_ctx ctx;
+	struct libxl_sched_credit c_scinfo;
+	int ret;
+
+	INIT_CTX();
+	ret = libxl_sched_credit_domain_get(&ctx, Int_val(domid), &c_scinfo);
+	if (ret != 0)
+		failwith_xl("sched_credit_domain_get");
+	FREE_CTX();
+	
+	scinfo = Val_sched_credit(&c_scinfo);
+	CAMLreturn(scinfo);
+}
+
+value stub_xl_sched_credit_domain_set(value domid, value scinfo)
+{
+	CAMLparam2(domid, scinfo);
+	struct libxl_ctx ctx;
+	struct libxl_sched_credit c_scinfo;
+	int ret;
+
+	sched_credit_val(&c_scinfo, scinfo);
+
+	INIT_CTX();
+	ret = libxl_sched_credit_domain_set(&ctx, Int_val(domid), &c_scinfo);
+	if (ret != 0)
+		failwith_xl("sched_credit_domain_set");
+	FREE_CTX();
+	
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_send_trigger(value domid, value trigger, value vcpuid)
+{
+	CAMLparam3(domid, trigger, vcpuid);
+	struct libxl_ctx ctx;
+	int ret;
+
+	INIT_CTX();
+	ret = libxl_send_trigger(&ctx, Int_val(domid), String_val(trigger), Int_val(vcpuid));
+	if (ret != 0)
+		failwith_xl("send_trigger");
+	FREE_CTX();
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_send_sysrq(value domid, value sysrq)
+{
+	CAMLparam2(domid, sysrq);
+	struct libxl_ctx ctx;
+	int ret;
+
+	INIT_CTX();
+	ret = libxl_send_sysrq(&ctx, Int_val(domid), Int_val(sysrq));
+	if (ret != 0)
+		failwith_xl("send_sysrq");
+	FREE_CTX();
+	CAMLreturn(Val_unit);
+}
+
+value stub_xl_send_debug_keys(value keys)
+{
+	CAMLparam1(keys);
+	struct libxl_ctx ctx;
+	int ret;
+
+	INIT_CTX();
+	ret = libxl_send_debug_keys(&ctx, String_val(keys));
+	if (ret != 0)
+		failwith_xl("send_debug_keys");
+	FREE_CTX();
+	CAMLreturn(Val_unit);
+}
+
+/*
+ * Local variables:
+ *  indent-tabs-mode: t
+ *  c-basic-offset: 8
+ *  tab-width: 8
+ * End:
+ */
-- 
1.7.1

Re: [PATCH] add xl ocaml bindings

[Ian Campbell]

Not really a comment on this patch as such but more a related thought...
How many language bindings do we think there are going to be and how
much effort do we expect it would be keeping them all (or even just the
interesting subset) up to date?

Is it worth investing the time up front to define a (simple) IDL and to
generate the C header and language bindings from that?

Are there any existing IDLs which would meet our needs?

Another thought is that an IDL would partially isolate people changing
the libxl interface from needing to know enough about each language to
fixup the bindings (or else they may break the build). At least in the
normal case where the change does not require a change to the IDL then a
simple regeneration should be enough to update the bindings for the
change.

On the other hand sometimes maintaining the auto code generator can be
more work than just maintaining bindings by hand...

Ian.

Re: [PATCH] add xl ocaml bindings

[Vincent Hanquez]

On 28/06/10 10:59, Ian Campbell wrote:
> Not really a comment on this patch as such but more a related thought...
> How many language bindings do we think there are going to be and how
> much effort do we expect it would be keeping them all (or even just the
> interesting subset) up to date?
>    
I'm not sure if you're asking generally in terms of languages or in 
terms of bindings. I think from the point of view of bindings, that was 
the only thing left that required a binding. in terms of language, I 
don't really know if anyone is going to add some python bindings or not. 
it depends if xend is going to die, or is going to be ported.

effort wise, it's hard to answer since it depends on lots of variables. 
for example, API stability of libxenlight.

> Is it worth investing the time up front to define a (simple) IDL and to
> generate the C header and language bindings from that?
>
> Are there any existing IDLs which would meet our needs?
>    
Theoretically, yes. pratically there's no IDL that i know of, that 
generate anything remotely close to be good or even useful. (it's maybe 
no surprise that all the python bindings are not autogenerated either)

swig seems to generate bindings really close to the C layer which make 
it quite annoying since the ml glue code become quick thick and quite 
annoying to write (converting back and forth types) and i've never 
actually tested the output of swig, and last time i tried camlIDL on a 
simple example, it generated a code that would segfault.

one more thing about generic bindings generator, is that it's hard to 
provide nice and clean interfaces. most of the time you stay really 
close to the C layer, which defeat the whole point of using a high level 
language for the user.

FYI, I've rewritten a little program to help me generate the bindings 
actually, but yet, it's quite painful to get right (and it's not in any 
Xen-friendly language either), and in the end i decided to take some of 
the output and fix it up by hand. in any case, it's really really far 
from having a automatic "./program idl > code" step in the code.

> the libxl interface from needing to know enough about each language to
> fixup the bindings (or else they may break the build). At least in the
> normal case where the change does not require a change to the IDL then a
> simple regeneration should be enough to update the bindings for the
> change.
>    
hopefully in most cases, as long as everything doesn't change too badly, 
adding fields is relatively easy even for someone that doesn't know ocaml.

-- 
Vincent

Re: [PATCH] add xl ocaml bindings

[Marc - A. Dahlhaus]

Hello Ian,

Am Montag, den 28.06.2010, 10:59 +0100 schrieb Ian Campbell:
> Not really a comment on this patch as such but more a related thought...
> How many language bindings do we think there are going to be and how
> much effort do we expect it would be keeping them all (or even just the
> interesting subset) up to date?
> 
> Is it worth investing the time up front to define a (simple) IDL and to
> generate the C header and language bindings from that?
> 
> Are there any existing IDLs which would meet our needs?
> 
> Another thought is that an IDL would partially isolate people changing
> the libxl interface from needing to know enough about each language to
> fixup the bindings (or else they may break the build). At least in the
> normal case where the change does not require a change to the IDL then a
> simple regeneration should be enough to update the bindings for the
> change.
> 
> On the other hand sometimes maintaining the auto code generator can be
> more work than just maintaining bindings by hand...
> 
> Ian.

maybe http://www.swig.org/ might help in this case.

It supports ocaml, python and also many more targets (like perl which i
would love to get :) )...

According to http://www.swig.org/tutorial.html it looks like it could
save the effort of maintaining the bindings one by one in parallel...


Marc

Re: [PATCH] add xl ocaml bindings

[Stefano Stabellini]

On Mon, 28 Jun 2010, Zhigang Wang wrote:
> I did some investigation on python bindings. It seems the best way today is
> using ctypes.
> 
> There are a few tools to autogenerate the bindings, but in my mind, the best way
> is: generate at first time and then make some changes and maintain it manually.
> I think user readability is most important.
> 
> And I was thinking xl should written in python.
> 

We already have a toolstack written in python: xend.
I think that rather than rewriting xl in python, it would be much better
to port xend to libxl.

Re: [PATCH] add xl ocaml bindings [and 1 more messages]

[Ian Jackson]

Ian Campbell writes ("Re: [Xen-devel] [PATCH] add xl ocaml bindings"):
> Is it worth investing the time up front to define a (simple) IDL and to
> generate the C header and language bindings from that?

I think so but this is not a trivial problem, and we shouldn't block
new language bindings on the availability of an IDL compiler.

> Are there any existing IDLs which would meet our needs?

We've had a look, but unfortunately there aren't really.

Marc - A. Dahlhaus writes ("Re: [Xen-devel] [PATCH] add xl ocaml bindings"):
> maybe http://www.swig.org/ might help in this case.

Urgh.  Swig takes a pretty unpleasant approach.  I've been involved in
other projects which used it and it was more trouble than it was
worth.

Ian.

Re: [PATCH] add xl ocaml bindings

[Ian Jackson]

Vincent Hanquez writes ("[Xen-devel] [PATCH] add xl ocaml bindings"):
> Signed-off-by: Vincent Hanquez <vincent.hanquez@eu.citrix.com>

On my machine this breaks the build ("make -j4 KERNELS=''" with
everything relevant in ccache so the C parts of the build are very fast):

 === building libs/xl
make[4]: *** No targets specified and no makefile found.  Stop.
make[3]: *** [SUBDIRS_LIBS] Error 2
make[3]: Leaving directory `/u/iwj/work/xen-unstable-tools.hg/tools/ocaml'
make[2]: *** [subdir-install-ocaml] Error 2
make[2]: Leaving directory `/u/iwj/work/xen-unstable-tools.hg/tools'
make[1]: *** [subdirs-install] Error 2
make[1]: Leaving directory `/u/iwj/work/xen-unstable-tools.hg/tools'
make: *** [install-tools] Error 2
make: *** Waiting for unfinished jobs....

Ian.

[PATCH] missing makefile for libxl

[Vincent Hanquez]

Signed-off-by: Vincent Hanquez <vincent.hanquez@eu.citrix.com>
---
 tools/ocaml/libs/xl/Makefile |   26 ++++++++++++++++++++++++++
 1 files changed, 26 insertions(+), 0 deletions(-)
 create mode 100644 tools/ocaml/libs/xl/Makefile

diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile
new file mode 100644
index 0000000..2061e25
--- /dev/null
+++ b/tools/ocaml/libs/xl/Makefile
@@ -0,0 +1,26 @@
+TOPLEVEL=../..
+XEN_ROOT=$(TOPLEVEL)/../..
+include $(TOPLEVEL)/common.make
+
+OBJS = xl
+INTF = xl.cmi
+LIBS = xl.cma xl.cmxa
+
+xl_OBJS = $(OBJS)
+xl_C_OBJS = xl_stubs
+
+OCAML_LIBRARY = xl
+
+all: $(INTF) $(LIBS)
+
+libs: $(LIBS)
+
+.PHONY: install
+install: $(LIBS) META
+	ocamlfind install -destdir $(DESTDIR)$(shell ocamlfind printconf destdir) -ldconf ignore xl META $(INTF) $(LIBS) *.a *.so *.cmx
+
+.PHONY: uninstall
+uninstall:
+	ocamlfind remove xl
+
+include $(TOPLEVEL)/Makefile.rules
-- 
1.7.1

Re: [PATCH] add xl ocaml bindings

[Zhigang Wang]

I did some investigation on python bindings. It seems the best way today is
using ctypes.

There are a few tools to autogenerate the bindings, but in my mind, the best way
is: generate at first time and then make some changes and maintain it manually.
I think user readability is most important.

And I was thinking xl should written in python.

Thanks,

Zhigang

On 06/28/2010 07:30 PM, Vincent Hanquez wrote:
> On 28/06/10 10:59, Ian Campbell wrote:
>> Not really a comment on this patch as such but more a related thought...
>> How many language bindings do we think there are going to be and how
>> much effort do we expect it would be keeping them all (or even just the
>> interesting subset) up to date?
>>    
> I'm not sure if you're asking generally in terms of languages or in 
> terms of bindings. I think from the point of view of bindings, that was 
> the only thing left that required a binding. in terms of language, I 
> don't really know if anyone is going to add some python bindings or not. 
> it depends if xend is going to die, or is going to be ported.
> 
> effort wise, it's hard to answer since it depends on lots of variables. 
> for example, API stability of libxenlight.
> 
>> Is it worth investing the time up front to define a (simple) IDL and to
>> generate the C header and language bindings from that?
>>
>> Are there any existing IDLs which would meet our needs?
>>    
> Theoretically, yes. pratically there's no IDL that i know of, that 
> generate anything remotely close to be good or even useful. (it's maybe 
> no surprise that all the python bindings are not autogenerated either)
> 
> swig seems to generate bindings really close to the C layer which make 
> it quite annoying since the ml glue code become quick thick and quite 
> annoying to write (converting back and forth types) and i've never 
> actually tested the output of swig, and last time i tried camlIDL on a 
> simple example, it generated a code that would segfault.
> 
> one more thing about generic bindings generator, is that it's hard to 
> provide nice and clean interfaces. most of the time you stay really 
> close to the C layer, which defeat the whole point of using a high level 
> language for the user.
> 
> FYI, I've rewritten a little program to help me generate the bindings 
> actually, but yet, it's quite painful to get right (and it's not in any 
> Xen-friendly language either), and in the end i decided to take some of 
> the output and fix it up by hand. in any case, it's really really far 
> from having a automatic "./program idl > code" step in the code.
> 
>> the libxl interface from needing to know enough about each language to
>> fixup the bindings (or else they may break the build). At least in the
>> normal case where the change does not require a change to the IDL then a
>> simple regeneration should be enough to update the bindings for the
>> change.
>>    
> hopefully in most cases, as long as everything doesn't change too badly, 
> adding fields is relatively easy even for someone that doesn't know ocaml.
>