From mboxrd@z Thu Jan 1 00:00:00 1970 From: Rob Hoes Subject: [PATCH v3-RESEND 06/28] libxc: ocaml: add simple binding for xentoollog (output only). Date: Mon, 21 Oct 2013 14:32:23 +0100 Message-ID: <1382362365-6645-7-git-send-email-rob.hoes@citrix.com> References: <1382362365-6645-1-git-send-email-rob.hoes@citrix.com> Mime-Version: 1.0 Content-Type: text/plain; charset="us-ascii" Content-Transfer-Encoding: 7bit Return-path: In-Reply-To: <1382362365-6645-1-git-send-email-rob.hoes@citrix.com> List-Unsubscribe: , List-Post: List-Help: List-Subscribe: , Sender: xen-devel-bounces@lists.xen.org Errors-To: xen-devel-bounces@lists.xen.org To: xen-devel@lists.xen.org Cc: ian.jackson@eu.citrix.com, ian.campbell@citrix.com, Rob Hoes List-Id: xen-devel@lists.xenproject.org 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 Signed-off-by: Rob Hoes --- New in v3: * Auto-generate the log-level converters from xentoollog.h. * Move the stdio logger from the library to the test suite. * Use a counter instead of a random number when registering a callback. --- .gitignore | 1 + .hgignore | 1 + tools/ocaml/Makefile | 2 +- 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 ++++++++++++++++++++++++ tools/ocaml/test/Makefile | 28 ++++ tools/ocaml/test/xtl.ml | 40 +++++ 14 files changed, 576 insertions(+), 2 deletions(-) create mode 100644 tools/ocaml/libs/xentoollog/META.in create mode 100644 tools/ocaml/libs/xentoollog/Makefile create mode 100644 tools/ocaml/libs/xentoollog/caml_xentoollog.h create mode 100755 tools/ocaml/libs/xentoollog/genlevels.py create mode 100644 tools/ocaml/libs/xentoollog/xentoollog.ml.in create mode 100644 tools/ocaml/libs/xentoollog/xentoollog.mli.in create mode 100644 tools/ocaml/libs/xentoollog/xentoollog_stubs.c create mode 100644 tools/ocaml/test/Makefile create mode 100644 tools/ocaml/test/xtl.ml diff --git a/.gitignore b/.gitignore index 3253675..f51c345 100644 --- a/.gitignore +++ b/.gitignore @@ -384,6 +384,7 @@ tools/ocaml/libs/xl/_libxl_types.mli.in tools/ocaml/libs/xl/xenlight.ml tools/ocaml/libs/xl/xenlight.mli tools/ocaml/xenstored/oxenstored +tools/ocaml/test/xtl tools/debugger/kdd/kdd tools/firmware/etherboot/ipxe.tar.gz diff --git a/.hgignore b/.hgignore index 05cb0de..bb1b67d 100644 --- a/.hgignore +++ b/.hgignore @@ -308,6 +308,7 @@ ^tools/ocaml/libs/xl/xenlight\.ml$ ^tools/ocaml/libs/xl/xenlight\.mli$ ^tools/ocaml/xenstored/oxenstored$ +^tools/ocaml/test/xtl$ ^tools/autom4te\.cache$ ^tools/config\.h$ ^tools/config\.log$ diff --git a/tools/ocaml/Makefile b/tools/ocaml/Makefile index 6b22bbe..8e4ca36 100644 --- a/tools/ocaml/Makefile +++ b/tools/ocaml/Makefile @@ -1,7 +1,7 @@ XEN_ROOT = $(CURDIR)/../.. include $(XEN_ROOT)/tools/Rules.mk -SUBDIRS_PROGRAMS = xenstored +SUBDIRS_PROGRAMS = xenstored test SUBDIRS = libs $(SUBDIRS_PROGRAMS) 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 + * Author Rob Hoes + * + * 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 " + 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 + * + * 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 + * + * 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 or None + context: Some or None + message: The log message (already formatted) + progress: + context: Some 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 + * + * 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 +#include +#include +#include + +#define CAML_NAME_SPACE +#include +#include +#include +#include +#include +#include + +#include + +#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); +} + diff --git a/tools/ocaml/test/Makefile b/tools/ocaml/test/Makefile new file mode 100644 index 0000000..980054c --- /dev/null +++ b/tools/ocaml/test/Makefile @@ -0,0 +1,28 @@ +XEN_ROOT = $(CURDIR)/../../.. +OCAML_TOPLEVEL = $(CURDIR)/.. +include $(OCAML_TOPLEVEL)/common.make + +OCAMLINCLUDE += \ + -I $(OCAML_TOPLEVEL)/libs/xentoollog + +OBJS = xtl + +PROGRAMS = xtl + +xtl_LIBS = \ + -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \ + -cclib -lxenctrl + +xtl_OBJS = xtl + +OCAML_PROGRAM = xtl + +all: $(PROGRAMS) + +bins: $(PROGRAMS) + +install: all + $(INSTALL_DIR) $(DESTDIR)$(BINDIR) + $(INSTALL_PROG) $(PROGRAMS) $(DESTDIR)$(BINDIR) + +include $(OCAML_TOPLEVEL)/Makefile.rules diff --git a/tools/ocaml/test/xtl.ml b/tools/ocaml/test/xtl.ml new file mode 100644 index 0000000..db30aae --- /dev/null +++ b/tools/ocaml/test/xtl.ml @@ -0,0 +1,40 @@ +open Arg +open Printf +open Xentoollog + +let stdio_vmessage min_level level errno ctx msg = + let level_str = level_to_string level + and errno_str = match errno with None -> "" | Some s -> sprintf ": errno=%d" s + and ctx_str = match ctx with None -> "" | Some s -> sprintf ": %s" s in + if compare min_level level <= 0 then begin + printf "%s%s%s: %s\n" level_str ctx_str errno_str msg; + flush stdout; + end + +let stdio_progress ctx what percent dne total = + let nl = if dne = total then "\n" else "" in + printf "\rProgress %s %d%% (%Ld/%Ld)%s" what percent dne total nl; + flush stdout + +let create_stdio_logger ?(level=Info) () = + let cbs = { + vmessage = stdio_vmessage level; + progress = stdio_progress; } in + create "Xentoollog.stdio_logger" cbs + +let do_test level = + let lgr = create_stdio_logger ~level:level () in + begin + test lgr; + end + +let () = + let debug_level = ref Info in + let speclist = [ + ("-v", Arg.Unit (fun () -> debug_level := Debug), "Verbose"); + ("-q", Arg.Unit (fun () -> debug_level := Critical), "Quiet"); + ] in + let usage_msg = "usage: xtl [OPTIONS]" in + Arg.parse speclist (fun s -> ()) usage_msg; + + do_test !debug_level -- 1.7.10.4