libxl: ocaml: add console reader functions
authorRob Hoes <rob.hoes@citrix.com>
Tue, 10 Dec 2013 16:48:31 +0000 (16:48 +0000)
committerIan Campbell <ian.campbell@citrix.com>
Wed, 11 Dec 2013 13:17:50 +0000 (13:17 +0000)
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
tools/ocaml/libs/xl/xenlight.ml.in
tools/ocaml/libs/xl/xenlight.mli.in
tools/ocaml/libs/xl/xenlight_stubs.c
tools/ocaml/test/Makefile
tools/ocaml/test/dmesg.ml [new file with mode: 0644]

index fc051120fd5d3e9b59a1ee2e0fce6b495fffab68..47f34878a8bb6873053637189cb86b6dc9243795 100644 (file)
@@ -49,6 +49,13 @@ module Domain = struct
 end
 
 module Host = struct
+       type console_reader
+       exception End_of_file
+
+       external xen_console_read_start : ctx -> int -> console_reader  = "stub_libxl_xen_console_read_start"
+       external xen_console_read_line : ctx -> console_reader -> string = "stub_libxl_xen_console_read_line"
+       external xen_console_read_finish : ctx -> console_reader -> unit = "stub_libxl_xen_console_read_finish"
+
        external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
 end
 
@@ -82,5 +89,6 @@ module Async = struct
 end
 
 let register_exceptions () =
-       Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, ""))
+       Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, ""));
+       Callback.register_exception "Xenlight.Host.End_of_file" (Host.End_of_file)
 
index ee4efd81c1c9e6bd74d9b2745710178e11cd0a99..794dbf1aa6f26f740c6cfcb8c3633f14b69404ce 100644 (file)
@@ -51,6 +51,13 @@ module Domain : sig
 end
 
 module Host : sig
+       type console_reader
+       exception End_of_file
+
+       external xen_console_read_start : ctx -> int -> console_reader  = "stub_libxl_xen_console_read_start"
+       external xen_console_read_line : ctx -> console_reader -> string = "stub_libxl_xen_console_read_line"
+       external xen_console_read_finish : ctx -> console_reader -> unit = "stub_libxl_xen_console_read_finish"
+
        external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
 end
 
index 6297c2f6adfed7294e6bd1471629a3b6c7e81bfa..1d299baf541a6983a2752c669e5175be3af419ec 100644 (file)
@@ -939,6 +939,74 @@ value stub_xl_send_debug_keys(value ctx, value keys)
        CAMLreturn(Val_unit);
 }
 
+static struct custom_operations libxl_console_reader_custom_operations = {
+       "libxl_console_reader_custom_operations",
+       custom_finalize_default,
+       custom_compare_default,
+       custom_hash_default,
+       custom_serialize_default,
+       custom_deserialize_default
+};
+
+#define Console_reader_val(x)(*((libxl_xen_console_reader **) Data_custom_val(x)))
+
+value stub_libxl_xen_console_read_start(value ctx, value clear)
+{
+       CAMLparam2(ctx, clear);
+       CAMLlocal1(handle);
+       libxl_xen_console_reader *cr;
+
+       cr = libxl_xen_console_read_start(CTX, Int_val(clear));
+
+       handle = caml_alloc_custom(&libxl_console_reader_custom_operations, sizeof(cr), 0, 1);
+       Console_reader_val(handle) = cr;
+
+       CAMLreturn(handle);
+}
+
+static void raise_eof(void)
+{
+       static value *exc = NULL;
+
+       /* First time around, lookup by name */
+       if (!exc)
+               exc = caml_named_value("Xenlight.Host.End_of_file");
+
+       if (!exc)
+               caml_invalid_argument("Exception Xenlight.Host.End_of_file not initialized, please link xenlight.cma");
+
+       caml_raise_constant(*exc);
+}
+
+value stub_libxl_xen_console_read_line(value ctx, value reader)
+{
+       CAMLparam2(ctx, reader);
+       CAMLlocal1(line);
+       int ret;
+       char *c_line;
+       libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
+
+       ret = libxl_xen_console_read_line(CTX, cr, &c_line);
+
+       if (ret < 0)
+               failwith_xl(ret, "xen_console_read_line");
+       if (ret == 0)
+               raise_eof();
+
+       line = caml_copy_string(c_line);
+
+       CAMLreturn(line);
+}
+
+value stub_libxl_xen_console_read_finish(value ctx, value reader)
+{
+       CAMLparam2(ctx, reader);
+       libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
+
+       libxl_xen_console_read_finish(CTX, cr);
+
+       CAMLreturn(Val_unit);
+}
 
 /* Event handling */
 
index dfa643750b8a92e0435af97b0b4effc70d925a07..827bd7ca3903583994fb25ac259841826a149b28 100644 (file)
@@ -9,9 +9,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 dmesg
 
-PROGRAMS = xtl send_debug_keys list_domains raise_exception
+PROGRAMS = xtl send_debug_keys list_domains raise_exception dmesg
 
 xtl_LIBS =  \
        -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
@@ -37,7 +37,13 @@ raise_exception_LIBS =  \
 
 raise_exception_OBJS = raise_exception
 
-OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception
+dmesg_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
+
+dmesg_OBJS = xtl dmesg
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception dmesg
 
 all: $(PROGRAMS)
 
diff --git a/tools/ocaml/test/dmesg.ml b/tools/ocaml/test/dmesg.ml
new file mode 100644 (file)
index 0000000..864fac4
--- /dev/null
@@ -0,0 +1,18 @@
+open Printf
+
+let _ =
+       Xenlight.register_exceptions ();
+       let logger = Xtl.create_stdio_logger ~level:Xentoollog.Debug () in
+       let ctx = Xenlight.ctx_alloc logger in
+
+       let open Xenlight.Host in
+       let reader = xen_console_read_start ctx 0 in
+       (try
+               while true do
+                       let line = xen_console_read_line ctx reader in
+                       print_string line
+               done
+       with End_of_file -> ());
+       let _ = xen_console_read_finish ctx reader in
+       ()
+