Re: [Xen-API] [Xen-devel] [PATCH 10 of 15] libxc/ocaml: Add simple binding for xentoollog (output only)

[Rob Hoes <Rob.Hoes@xxxxxxxxxx>]

> # HG changeset patch
> # User Ian Campbell <ijc@xxxxxxxxxxxxxx> # Date 1353432141 0 # Node ID
> 2b433b1523e4295bb1ed74a7b71e2a20e00f1802
> # Parent  5173d29f64fa541f6ec0c48481c4957a03f0302c
> 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>
> 

This is potentially very useful. However, I have a few concerns about the 
callbacks to OCaml.

The most important issue is that we'd like to wrap potentially blocking C code 
in caml_enter_blocking_section and caml_leave_blocking section calls, to make 
sure that this code won't block the entire OCaml program. Within such a block, 
it is not allowed to interact with the OCaml runtime in any way. This includes 
callbacks.

I have notice some weird segfaults happening when using this logging code, and 
they seemed to have gone away when I removed the blocking_section calls.

I can't think of a good solution yet, but to make this really useful, I think 
we may need to do it slightly differently.

I included some smaller comments below.

> diff -r 5173d29f64fa -r 2b433b1523e4 .gitignore
> --- a/.gitignore      Tue Nov 20 17:22:21 2012 +0000
> +++ b/.gitignore      Tue Nov 20 17:22:21 2012 +0000
> @@ -364,6 +364,7 @@ tools/ocaml/libs/xl/_libxl_types.mli.in

[.....]

> +static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
> +                            xentoollog_level level,
> +                            int errnoval,
> +                            const char *context,
> +                            const char *format,
> +                            va_list al)
> +{
> +     struct caml_xtl *xtl = (struct caml_xtl*)logger;
> +     value *func = caml_named_value(xtl->vmessage_cb) ;
> +     value args[4];

I think it is safer to use this instead:

       CAMLparam0();
       CAMLlocalN(args, 4);

> +     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);

Because of the above, we should also add 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) {
> +     struct caml_xtl *xtl = (struct caml_xtl*)logger;
> +     value *func = caml_named_value(xtl->progress_cb) ;
> +     value args[5];

Here as well:

       CAMLparam0();
       CAMLlocalN(args, 5);

> +
> +     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);

And 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);
> +}
> +

[...]

> diff -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/test/Makefile
> --- /dev/null Thu Jan 01 00:00:00 1970 +0000
> +++ b/tools/ocaml/test/Makefile       Tue Nov 20 17:22:21 2012 +0000
> @@ -0,0 +1,27 @@
> +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

I had to add "-cclib -lxenctrl" here to get it to link properly.

> +
> +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 -r 5173d29f64fa -r 2b433b1523e4 tools/ocaml/test/xtl.ml
> --- /dev/null Thu Jan 01 00:00:00 1970 +0000
> +++ b/tools/ocaml/test/xtl.ml Tue Nov 20 17:22:21 2012 +0000
> @@ -0,0 +1,20 @@
> +open Arg
> +open Xentoollog
> +
> +let do_test level =
> +  let lgr = Xentoollog.create_stdio_logger ~level:level () in
> +  begin
> +    Xentoollog.test lgr;
> +    Xentoollog.destroy lgr;
> +  end
> +
> +let () =
> +  let debug_level = ref Xentoollog.Info in
> +  let speclist = [
> +    ("-v", Arg.Unit (fun () -> debug_level := Xentoollog.Debug), "Verbose");
> +    ("-q", Arg.Unit (fun () -> debug_level := Xentoollog.Critical),
> +"Quiet");
> +  ] in
> +  let usage_msg = "usage: xtl [OPTIONS]" in
> +  Arg.parse speclist (fun s -> ()) usage_msg;
> +
> +  do_test !debug_level
> 

Cheers,
Rob

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