|
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index] [Xen-changelog] [xen master] libxc: ocaml: add simple binding for xentoollog (output only).
commit 65e35eb12447eb0c7343a1286f5c80138b5e5c84
Author: Rob Hoes <rob.hoes@xxxxxxxxxx>
AuthorDate: Wed Nov 6 17:49:43 2013 +0000
Commit: Ian Campbell <ian.campbell@xxxxxxxxxx>
CommitDate: Mon Nov 11 15:38:26 2013 +0000
libxc: ocaml: add simple binding for xentoollog (output only).
These bindings allow ocaml code to receive log message via xentoollog
but do not support injecting messages into xentoollog from ocaml.
Receiving log messages from libx{c,l} and forwarding them to ocaml is
the use case which is needed by the following patches.
Add a simple noddy test case (tools/ocaml/test).
Signed-off-by: Ian Campbell <ian.campbell@xxxxxxxxxx>
Signed-off-by: Rob Hoes <rob.hoes@xxxxxxxxxx>
Acked-by: David Scott <dave.scott@xxxxxxxxxxxxx>
[ ijc -- dropped the xtl test harness, it failed to link ]
---
tools/ocaml/Makefile.rules | 2 +-
tools/ocaml/libs/Makefile | 1 +
tools/ocaml/libs/xentoollog/META.in | 4 +
tools/ocaml/libs/xentoollog/Makefile | 61 ++++++++
tools/ocaml/libs/xentoollog/caml_xentoollog.h | 24 +++
tools/ocaml/libs/xentoollog/genlevels.py | 127 +++++++++++++++
tools/ocaml/libs/xentoollog/xentoollog.ml.in | 48 ++++++
tools/ocaml/libs/xentoollog/xentoollog.mli.in | 43 +++++
tools/ocaml/libs/xentoollog/xentoollog_stubs.c | 196 ++++++++++++++++++++++++
9 files changed, 505 insertions(+), 1 deletions(-)
diff --git a/tools/ocaml/Makefile.rules b/tools/ocaml/Makefile.rules
index 5e6d81e..0745e83 100644
--- a/tools/ocaml/Makefile.rules
+++ b/tools/ocaml/Makefile.rules
@@ -24,7 +24,7 @@ ALL_OCAML_OBJS ?= $(OBJS)
%.cmi: %.mli
$(call quiet-command, $(OCAMLC) $(OCAMLCFLAGS) -c -o $@ $<,MLI,$@)
-%.cmx: %.ml
+%.cmx %.o: %.ml
$(call quiet-command, $(OCAMLOPT) $(OCAMLOPTFLAGS) -c -o $@ $<,MLOPT,$@)
%.ml: %.mll
diff --git a/tools/ocaml/libs/Makefile b/tools/ocaml/libs/Makefile
index bca0fa2..3afdc89 100644
--- a/tools/ocaml/libs/Makefile
+++ b/tools/ocaml/libs/Makefile
@@ -3,6 +3,7 @@ include $(XEN_ROOT)/tools/Rules.mk
SUBDIRS= \
mmap \
+ xentoollog \
xc eventchn \
xb xs xl
diff --git a/tools/ocaml/libs/xentoollog/META.in
b/tools/ocaml/libs/xentoollog/META.in
new file mode 100644
index 0000000..7b06683
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/META.in
@@ -0,0 +1,4 @@
+version = "@VERSION@"
+description = "Xen Tools Logger Interface"
+archive(byte) = "xentoollog.cma"
+archive(native) = "xentoollog.cmxa"
diff --git a/tools/ocaml/libs/xentoollog/Makefile
b/tools/ocaml/libs/xentoollog/Makefile
new file mode 100644
index 0000000..e535ba5
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/Makefile
@@ -0,0 +1,61 @@
+TOPLEVEL=$(CURDIR)/../..
+XEN_ROOT=$(TOPLEVEL)/../..
+include $(TOPLEVEL)/common.make
+
+CFLAGS += $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest)
+OCAMLINCLUDE +=
+
+OBJS = xentoollog
+INTF = xentoollog.cmi
+LIBS = xentoollog.cma xentoollog.cmxa
+
+LIBS_xentoollog = $(LDLIBS_libxenctrl)
+
+xentoollog_OBJS = $(OBJS)
+xentoollog_C_OBJS = xentoollog_stubs
+
+OCAML_LIBRARY = xentoollog
+
+GENERATED_FILES += xentoollog.ml xentoollog.ml.tmp xentoollog.mli
xentoollog.mli.tmp
+GENERATED_FILES += _xtl_levels.mli.in _xtl_levels.ml.in _xtl_levels.inc META
+
+all: $(INTF) $(LIBS)
+
+xentoollog.ml: xentoollog.ml.in _xtl_levels.ml.in
+ $(Q)sed -e '1i\
+(*\
+ * AUTO-GENERATED FILE DO NOT EDIT\
+ * Generated from xentoollog.ml.in and _xtl_levels.ml.in\
+ *)\
+' \
+ -e '/^(\* @@XTL_LEVELS@@ \*)$$/r_xtl_levels.ml.in' \
+ < xentoollog.ml.in > xentoollog.ml.tmp
+ $(Q)mv xentoollog.ml.tmp xentoollog.ml
+
+xentoollog.mli: xentoollog.mli.in _xtl_levels.mli.in
+ $(Q)sed -e '1i\
+(*\
+ * AUTO-GENERATED FILE DO NOT EDIT\
+ * Generated from xentoollog.mli.in and _xtl_levels.mli.in\
+ *)\
+' \
+ -e '/^(\* @@XTL_LEVELS@@ \*)$$/r_xtl_levels.mli.in' \
+ < xentoollog.mli.in > xentoollog.mli.tmp
+ $(Q)mv xentoollog.mli.tmp xentoollog.mli
+
+libs: $(LIBS)
+
+_xtl_levels.ml.in _xtl_levels.mli.in _xtl_levels.inc: genlevels.py
$(XEN_ROOT)/tools/libxc/xentoollog.h
+ $(PYTHON) genlevels.py _xtl_levels.mli.in _xtl_levels.ml.in
_xtl_levels.inc
+
+.PHONY: install
+install: $(LIBS) META
+ mkdir -p $(OCAMLDESTDIR)
+ ocamlfind remove -destdir $(OCAMLDESTDIR) xentoollog
+ ocamlfind install -destdir $(OCAMLDESTDIR) -ldconf ignore xentoollog
META $(INTF) $(LIBS) *.a *.so *.cmx
+
+.PHONY: uninstall
+uninstall:
+ ocamlfind remove -destdir $(OCAMLDESTDIR) xentoollog
+
+include $(TOPLEVEL)/Makefile.rules
diff --git a/tools/ocaml/libs/xentoollog/caml_xentoollog.h
b/tools/ocaml/libs/xentoollog/caml_xentoollog.h
new file mode 100644
index 0000000..0eb7618
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/caml_xentoollog.h
@@ -0,0 +1,24 @@
+/*
+ * Copyright (C) 2013 Citrix Ltd.
+ * Author Ian Campbell <ian.campbell@xxxxxxxxxx>
+ * Author Rob Hoes <rob.hoes@xxxxxxxxxx>
+ *
+ * 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.
+ */
+
+struct caml_xtl {
+ xentoollog_logger vtable;
+ char *vmessage_cb;
+ char *progress_cb;
+};
+
+#define Xtl_val(x)(*((struct caml_xtl **) Data_custom_val(x)))
+
diff --git a/tools/ocaml/libs/xentoollog/genlevels.py
b/tools/ocaml/libs/xentoollog/genlevels.py
new file mode 100755
index 0000000..6b42f21
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/genlevels.py
@@ -0,0 +1,127 @@
+#!/usr/bin/python
+
+import sys
+
+def read_levels():
+ f = open('../../../libxc/xentoollog.h', 'r')
+
+ levels = []
+ record = False
+ for l in f.readlines():
+ if 'XTL_NUM_LEVELS' in l:
+ break
+ if record == True:
+ levels.append(l.split(',')[0].strip())
+ if 'XTL_NONE' in l:
+ record = True
+
+ f.close()
+
+ olevels = [level[4:].capitalize() for level in levels]
+
+ return levels, olevels
+
+# .ml
+
+def gen_ml(olevels):
+ s = ""
+
+ s += "type level = \n"
+ for level in olevels:
+ s += '\t| %s\n' % level
+
+ s += "\nlet level_to_string level =\n"
+ s += "\tmatch level with\n"
+ for level in olevels:
+ s += '\t| %s -> "%s"\n' % (level, level)
+
+ s += "\nlet level_to_prio level =\n"
+ s += "\tmatch level with\n"
+ for index,level in enumerate(olevels):
+ s += '\t| %s -> %d\n' % (level, index)
+
+ return s
+
+# .mli
+
+def gen_mli(olevels):
+ s = ""
+
+ s += "type level = \n"
+ for level in olevels:
+ s += '\t| %s\n' % level
+
+ return s
+
+# .c
+
+def gen_c(level):
+ s = ""
+
+ s += "static value Val_level(xentoollog_level c_level)\n"
+ s += "{\n"
+ s += "\tswitch (c_level) {\n"
+ s += "\tcase XTL_NONE: /* Not a real value */\n"
+ s += '\t\tcaml_raise_sys_error(caml_copy_string("Val_level
XTL_NONE"));\n'
+ s += "\t\tbreak;\n"
+
+ for index,level in enumerate(levels):
+ s += "\tcase %s:\n\t\treturn Val_int(%d);\n" % (level, index)
+
+ s += """\tcase XTL_NUM_LEVELS: /* Not a real value! */
+ \t\tcaml_raise_sys_error(
+ \t\t\tcaml_copy_string("Val_level XTL_NUM_LEVELS"));
+ #if 0 /* Let the compiler catch this */
+ \tdefault:
+ \t\tcaml_raise_sys_error(caml_copy_string("Val_level Unknown"));
+ \t\tbreak;
+ #endif
+ \t}
+ \tabort();
+ }
+ """
+
+ return s
+
+def autogen_header(open_comment, close_comment):
+ s = open_comment + " AUTO-GENERATED FILE DO NOT EDIT " + close_comment +
"\n"
+ s += open_comment + " autogenerated by \n"
+ s += reduce(lambda x,y: x + " ", range(len(open_comment + " ")), "")
+ s += "%s" % " ".join(sys.argv)
+ s += "\n " + close_comment + "\n\n"
+ return s
+
+if __name__ == '__main__':
+ if len(sys.argv) < 3:
+ print >>sys.stderr, "Usage: genlevels.py <mli> <ml> <c-inc>"
+ sys.exit(1)
+
+ levels, olevels = read_levels()
+
+ _mli = sys.argv[1]
+ mli = open(_mli, 'w')
+ mli.write(autogen_header("(*", "*)"))
+
+ _ml = sys.argv[2]
+ ml = open(_ml, 'w')
+ ml.write(autogen_header("(*", "*)"))
+
+ _cinc = sys.argv[3]
+ cinc = open(_cinc, 'w')
+ cinc.write(autogen_header("/*", "*/"))
+
+ mli.write(gen_mli(olevels))
+ mli.write("\n")
+
+ ml.write(gen_ml(olevels))
+ ml.write("\n")
+
+ cinc.write(gen_c(levels))
+ cinc.write("\n")
+
+ ml.write("(* END OF AUTO-GENERATED CODE *)\n")
+ ml.close()
+ mli.write("(* END OF AUTO-GENERATED CODE *)\n")
+ mli.close()
+ cinc.close()
+
diff --git a/tools/ocaml/libs/xentoollog/xentoollog.ml.in
b/tools/ocaml/libs/xentoollog/xentoollog.ml.in
new file mode 100644
index 0000000..ce9ea1d
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog.ml.in
@@ -0,0 +1,48 @@
+(*
+ * Copyright (C) 2012 Citrix Ltd.
+ * Author Ian Campbell <ian.campbell@xxxxxxxxxx>
+ *
+ * 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.
+ *)
+
+open Printf
+open Random
+open Callback
+
+(* @@XTL_LEVELS@@ *)
+
+let compare_level x y =
+ compare (level_to_prio x) (level_to_prio y)
+
+type handle
+
+type logger_cbs = {
+ vmessage : level -> int option -> string option -> string -> unit;
+ progress : string option -> string -> int -> int64 -> int64 -> unit;
+ (*destroy : unit -> unit*)
+}
+
+external _create_logger: (string * string) -> handle = "stub_xtl_create_logger"
+external test: handle -> unit = "stub_xtl_test"
+
+let counter = ref 0L
+
+let create name cbs : handle =
+ (* Callback names are supposed to be unique *)
+ let suffix = Int64.to_string !counter in
+ counter := Int64.succ !counter;
+ let vmessage_name = sprintf "%s_vmessage_%s" name suffix in
+ let progress_name = sprintf "%s_progress_%s" name suffix in
+ (*let destroy_name = sprintf "%s_destroy" name in*)
+ Callback.register vmessage_name cbs.vmessage;
+ Callback.register progress_name cbs.progress;
+ _create_logger (vmessage_name, progress_name)
+
diff --git a/tools/ocaml/libs/xentoollog/xentoollog.mli.in
b/tools/ocaml/libs/xentoollog/xentoollog.mli.in
new file mode 100644
index 0000000..05c098a
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog.mli.in
@@ -0,0 +1,43 @@
+(*
+ * Copyright (C) 2012 Citrix Ltd.
+ * Author Ian Campbell <ian.campbell@xxxxxxxxxx>
+ *
+ * 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.
+ *)
+
+(* @@XTL_LEVELS@@ *)
+
+val level_to_string : level -> string
+val compare_level : level -> level -> int
+
+type handle
+
+(** call back arguments. See xentoollog.h for more info.
+ vmessage:
+ level: level as above
+ errno: Some <errno> or None
+ context: Some <string> or None
+ message: The log message (already formatted)
+ progress:
+ context: Some <string> or None
+ doing_what: string
+ percent, done, total.
+*)
+type logger_cbs = {
+ vmessage : level -> int option -> string option -> string -> unit;
+ progress : string option -> string -> int -> int64 -> int64 -> unit;
+ (*destroy : handle -> unit*)
+}
+
+external test: handle -> unit = "stub_xtl_test"
+
+val create : string -> logger_cbs -> handle
+
diff --git a/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
new file mode 100644
index 0000000..3b2f91b
--- /dev/null
+++ b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
@@ -0,0 +1,196 @@
+/*
+ * Copyright (C) 2012 Citrix Ltd.
+ * Author Ian Campbell <ian.campbell@xxxxxxxxxx>
+ *
+ * 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.
+ */
+
+#define _GNU_SOURCE
+#include <stdio.h>
+#include <string.h>
+#include <unistd.h>
+#include <errno.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 <caml/custom.h>
+
+#include <xentoollog.h>
+
+#include "caml_xentoollog.h"
+
+#define XTL ((xentoollog_logger *) Xtl_val(handle))
+
+static char * dup_String_val(value s)
+{
+ int len;
+ char *c;
+ len = caml_string_length(s);
+ c = calloc(len + 1, sizeof(char));
+ if (!c)
+ caml_raise_out_of_memory();
+ memcpy(c, String_val(s), len);
+ return c;
+}
+
+#include "_xtl_levels.inc"
+
+/* Option type support as per
http://www.linux-nantes.org/~fmonnier/ocaml/ocaml-wrapping-c.php */
+#define Val_none Val_int(0)
+#define Some_val(v) Field(v,0)
+
+static value Val_some(value v)
+{
+ CAMLparam1(v);
+ CAMLlocal1(some);
+ some = caml_alloc(1, 0);
+ Store_field(some, 0, v);
+ CAMLreturn(some);
+}
+
+static value Val_errno(int errnoval)
+{
+ if (errnoval == -1)
+ return Val_none;
+ return Val_some(Val_int(errnoval));
+}
+
+static value Val_context(const char *context)
+{
+ if (context == NULL)
+ return Val_none;
+ return Val_some(caml_copy_string(context));
+}
+
+static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
+ xentoollog_level level,
+ int errnoval,
+ const char *context,
+ const char *format,
+ va_list al)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 4);
+ struct caml_xtl *xtl = (struct caml_xtl*)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)
+ caml_raise_out_of_memory();
+
+ /* vmessage : level -> int option -> string option -> string -> unit; */
+ args[0] = Val_level(level);
+ args[1] = Val_errno(errnoval);
+ args[2] = Val_context(context);
+ args[3] = caml_copy_string(msg);
+
+ free(msg);
+
+ caml_callbackN(*func, 4, args);
+ CAMLreturn0;
+}
+
+static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
+ const char *context,
+ const char *doing_what /* no \r,\n */,
+ int percent, unsigned long done, unsigned long total)
+{
+ CAMLparam0();
+ CAMLlocalN(args, 5);
+ 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"));
+
+ /* progress : string option -> string -> int -> int64 -> int64 -> unit;
*/
+ args[0] = Val_context(context);
+ args[1] = caml_copy_string(doing_what);
+ args[2] = Val_int(percent);
+ args[3] = caml_copy_int64(done);
+ args[4] = caml_copy_int64(total);
+
+ caml_callbackN(*func, 5, args);
+ CAMLreturn0;
+}
+
+static void xtl_destroy(struct xentoollog_logger *logger)
+{
+ struct caml_xtl *xtl = (struct caml_xtl*)logger;
+ free(xtl->vmessage_cb);
+ free(xtl->progress_cb);
+ free(xtl);
+}
+
+void xtl_finalize(value handle)
+{
+ xtl_destroy(XTL);
+}
+
+static struct custom_operations xentoollogger_custom_operations = {
+ "xentoollogger_custom_operations",
+ xtl_finalize /* custom_finalize_default */,
+ custom_compare_default,
+ custom_hash_default,
+ custom_serialize_default,
+ custom_deserialize_default
+};
+
+/* external _create_logger: (string * string) -> handle =
"stub_xtl_create_logger" */
+CAMLprim value stub_xtl_create_logger(value cbs)
+{
+ CAMLparam1(cbs);
+ CAMLlocal1(handle);
+ struct caml_xtl *xtl = malloc(sizeof(*xtl));
+ if (xtl == NULL)
+ caml_raise_out_of_memory();
+
+ memset(xtl, 0, sizeof(*xtl));
+
+ xtl->vtable.vmessage = &stub_xtl_ocaml_vmessage;
+ xtl->vtable.progress = &stub_xtl_ocaml_progress;
+ xtl->vtable.destroy = &xtl_destroy;
+
+ xtl->vmessage_cb = dup_String_val(Field(cbs, 0));
+ xtl->progress_cb = dup_String_val(Field(cbs, 1));
+
+ handle = caml_alloc_custom(&xentoollogger_custom_operations,
sizeof(xtl), 0, 1);
+ Xtl_val(handle) = xtl;
+
+ CAMLreturn(handle);
+}
+
+/* external test: handle -> unit = "stub_xtl_test" */
+CAMLprim value stub_xtl_test(value handle)
+{
+ unsigned long l;
+ CAMLparam1(handle);
+ xtl_log(XTL, XTL_DEBUG, -1, "debug", "%s -- debug", __func__);
+ xtl_log(XTL, XTL_INFO, -1, "test", "%s -- test 1", __func__);
+ xtl_log(XTL, XTL_INFO, ENOSYS, "test errno", "%s -- test 2", __func__);
+ xtl_log(XTL, XTL_CRITICAL, -1, "critical", "%s -- critical", __func__);
+ for (l = 0UL; l<=100UL; l += 10UL) {
+ xtl_progress(XTL, "progress", "testing", l, 100UL);
+ usleep(10000);
+ }
+ CAMLreturn(Val_unit);
+}
+
--
generated by git-patchbot for /home/xen/git/xen.git#master
_______________________________________________
Xen-changelog mailing list
Xen-changelog@xxxxxxxxxxxxx
http://lists.xensource.com/xen-changelog
|
 |
Lists.xenproject.org is hosted with RackSpace, monitoring our |