[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index] [Xen-API] [PATCH 13 of 15] libxl: ocaml: propagate the libxl return error code in exceptions
# HG changeset patch # User Ian Campbell <ijc@xxxxxxxxxxxxxx> # Date 1353432141 0 # Node ID c8d22bfef298ce525c98b5a3f0c394068ab01572 # Parent e4525795eac22c7d199ceae8714e95ed660a00c4 libxl: ocaml: propagate the libxl return error code in exceptions Signed-off-by: Ian Campbell <ian.campbell@xxxxxxxxxx> diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/genwrap.py --- a/tools/ocaml/libs/xl/genwrap.py Tue Nov 20 17:22:21 2012 +0000 +++ b/tools/ocaml/libs/xl/genwrap.py Tue Nov 20 17:22:21 2012 +0000 @@ -228,7 +228,7 @@ def c_val(ty, c, o, indent="", parent = for e in ty.values: s += " case %d: *%s = %s; break;\n" % (n, c, e.name) n += 1 - s += " default: failwith_xl(\"cannot convert value to %s\"); break;\n" % ty.typename + s += " default: failwith_xl(ERROR_FAIL, \"cannot convert value to %s\"); break;\n" % ty.typename s += "}" elif isinstance(ty, idl.KeyedUnion): s += "{\n" @@ -241,7 +241,7 @@ def c_val(ty, c, o, indent="", parent = parent + ty.keyvar.name, f.enumname) n += 1 - s += "\t\t default: failwith_xl(\"variant handling bug %s%s (long)\"); break;\n" % (parent, ty.keyvar.name) + s += "\t\t default: failwith_xl(ERROR_FAIL, \"variant handling bug %s%s (long)\"); break;\n" % (parent, ty.keyvar.name) s += "\t\t}\n" s += "\t} else {\n" s += "\t\t/* Is block... */\n" @@ -257,7 +257,7 @@ def c_val(ty, c, o, indent="", parent = s += "%s" % c_val(f.type, fexpr, o, indent=indent+"\t\t ") s += "break;\n" n += 1 - s += "\t\t default: failwith_xl(\"variant handling bug %s%s (block)\"); break;\n" % (parent, ty.keyvar.name) + s += "\t\t default: failwith_xl(ERROR_FAIL, \"variant handling bug %s%s (block)\"); break;\n" % (parent, ty.keyvar.name) s += "\t\t}\n" s += "\t}\n" s += "}" @@ -326,7 +326,7 @@ def ocaml_Val(ty, o, c, indent="", paren for e in ty.values: s += " case %s: %s = Int_val(%d); break;\n" % (e.name, o, n) n += 1 - s += " default: failwith_xl(\"cannot convert value from %s\"); break;\n" % ty.typename + s += " default: failwith_xl(ERROR_FAIL, \"cannot convert value from %s\"); break;\n" % ty.typename s += "}" elif isinstance(ty, idl.KeyedUnion): n = 0 @@ -347,7 +347,7 @@ def ocaml_Val(ty, o, c, indent="", paren #s += "\t %s = caml_alloc(%d,%d);\n" % (o,len(f.type.fields),n) s += "\t break;\n" n += 1 - s += "\t default: failwith_xl(\"cannot convert value from %s\"); break;\n" % ty.typename + s += "\t default: failwith_xl(ERROR_FAIL, \"cannot convert value from %s\"); break;\n" % ty.typename s += "\t}" elif isinstance(ty,idl.Aggregate) and (parent is None or ty.rawname is None): s += "{\n" diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/xenlight.ml.in --- a/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 +0000 +++ b/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 +0000 @@ -15,7 +15,47 @@ open Xentoollog -exception Error of string +type error = + Nonspecific | + Version | + Fail | + Ni | + Nomem | + Inval | + Badfail | + Guest_Timedout | + Timedout | + Noparavirt | + Not_Ready | + Osevent_Reg_Fail | + Bufferfull | + Unknown_Child + +let string_of_error error = + match error with + | Nonspecific -> "Non specific" + | Version -> "Version" + | Fail -> "Fail" + | Ni -> "Ni" + | Nomem -> "Nomem" + | Inval -> "Inval" + | Badfail -> "Badfail" + | Guest_Timedout -> "Guest Timedout" + | Timedout -> "Timedout" + | Noparavirt -> "Noparavirt" + | Not_Ready -> "Not Ready" + | Osevent_Reg_Fail -> "Osevent Reg Fail" + | Bufferfull -> "Bufferfull" + | Unknown_Child -> "Unknown Child" + +exception Error of (error * string) + +type ctx + +external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" +external ctx_free: ctx -> unit = "stub_libxl_ctx_free" + +external test_raise_exception: unit -> unit = "stub_raise_exception" type domid = int type devid = int @@ -26,15 +66,10 @@ end (* @@LIBXL_TYPES@@ *) -type ctx - -external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" -external ctx_free: ctx -> unit = "stub_libxl_ctx_free" - external list_domain: ctx -> Dominfo.t list = "stub_libxl_list_domain" external send_trigger : domid -> trigger -> int -> unit = "stub_xl_send_trigger" external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq" external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys" -let _ = Callback.register_exception "Xenlight.Error" (Error("")) +let _ = Callback.register_exception "Xenlight.Error" (Error(Fail, "")) diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/xenlight.mli.in --- a/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 +0000 +++ b/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 +0000 @@ -15,7 +15,32 @@ open Xentoollog -exception Error of string +type error = + Nonspecific | + Version | + Fail | + Ni | + Nomem | + Inval | + Badfail | + Guest_Timedout | + Timedout | + Noparavirt | + Not_Ready | + Osevent_Reg_Fail | + Bufferfull | + Unknown_Child + +val string_of_error: error -> string + +exception Error of (error * string) + +type ctx + +external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" +external ctx_free: ctx -> unit = "stub_libxl_ctx_free" + +external test_raise_exception: unit = "stub_raise_exception" type domid = int type devid = int @@ -24,9 +49,6 @@ type devid = int type ctx -external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" -external ctx_free: ctx -> unit = "stub_libxl_ctx_free" - external list_domain: ctx -> Dominfo.t list = "stub_libxl_list_domain" external send_trigger : domid -> trigger -> int -> unit = "stub_xl_send_trigger" diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/libs/xl/xenlight_stubs.c --- a/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 +0000 +++ b/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 +0000 @@ -43,12 +43,54 @@ static char * dup_String_val(value s) return c; } -static void failwith_xl(char *fname) +static value Val_error(int error) { + switch (error) { + case ERROR_NONSPECIFIC: return Val_int(0); + case ERROR_VERSION: return Val_int(1); + case ERROR_FAIL: return Val_int(2); + case ERROR_NI: return Val_int(3); + case ERROR_NOMEM: return Val_int(4); + case ERROR_INVAL: return Val_int(5); + case ERROR_BADFAIL: return Val_int(6); + case ERROR_GUEST_TIMEDOUT: return Val_int(7); + case ERROR_TIMEDOUT: return Val_int(8); + case ERROR_NOPARAVIRT: return Val_int(9); + case ERROR_NOT_READY: return Val_int(10); + case ERROR_OSEVENT_REG_FAIL: return Val_int(11); + case ERROR_BUFFERFULL: return Val_int(12); + case ERROR_UNKNOWN_CHILD: return Val_int(13); +#if 0 /* Let the compiler catch this */ + default: + caml_raise_sys_error(caml_copy_string("Unknown libxl ERROR")); + break; +#endif + } + /* Should not reach here */ + abort(); +} + +static void failwith_xl(int error, char *fname) +{ + CAMLlocal1(arg); value *exc = caml_named_value("Xenlight.Error"); + if (!exc) caml_invalid_argument("Exception Xenlight.Error not initialized, please link xl.cma"); - caml_raise_with_string(*exc, fname); + + arg = caml_alloc_small(2, 0); + + Field(arg, 0) = Val_error(error); + Field(arg, 1) = caml_copy_string(fname); + + caml_raise_with_arg(*exc, arg); +} + +CAMLprim value stub_raise_exception(value unit) +{ + CAMLparam1(unit); + failwith_xl(ERROR_FAIL, "test exception"); + CAMLreturn(Val_unit); } CAMLprim value stub_libxl_ctx_alloc(value logger) @@ -60,7 +102,7 @@ CAMLprim value stub_libxl_ctx_alloc(valu caml_enter_blocking_section(); ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *) logger); if (ret != 0) \ - failwith_xl("cannot init context"); + failwith_xl(ERROR_FAIL, "cannot init context"); caml_leave_blocking_section(); CAMLreturn((value)ctx); } @@ -190,7 +232,7 @@ static int Bitmap_val(libxl_ctx *ctx, li int i, len = Wosize_val(v); if (!libxl_bitmap_alloc(ctx, c_val, len)) - failwith_xl("cannot allocate bitmap"); + failwith_xl(ERROR_NOMEM, "cannot allocate bitmap"); for (i=0; i<len; i++) { if (Int_val(Field(v, i))) libxl_bitmap_set(c_val, i); @@ -295,7 +337,7 @@ value stub_libxl_list_domain(value ctx) info = libxl_list_domain(CTX, &nr); if (info == NULL) - failwith_xl("list_domain"); + failwith_xl(ERROR_FAIL, "list_domain"); cli = Val_emptylist; @@ -332,7 +374,7 @@ value stub_xl_device_##type##_##op(value libxl_device_##type##_dispose(&c_info); \ \ if (ret != 0) \ - failwith_xl(STRINGIFY(type) "_" STRINGIFY(op)); \ + failwith_xl(ret, STRINGIFY(type) "_" STRINGIFY(op)); \ \ CAMLreturn(Val_unit); \ } @@ -358,7 +400,7 @@ value stub_xl_physinfo_get(value ctx) ret = libxl_get_physinfo(CTX, &c_physinfo); if (ret != 0) - failwith_xl("get_physinfo"); + failwith_xl(ret, "get_physinfo"); physinfo = Val_physinfo(CTX, &c_physinfo); @@ -377,7 +419,7 @@ value stub_xl_cputopology_get(value ctx) c_topology = libxl_get_cpu_topology(CTX, &nr); if (!c_topology) - failwith_xl("topologyinfo"); + failwith_xl(ERROR_FAIL, "get_cpu_topologyinfo"); topology = caml_alloc_tuple(nr); for (i = 0; i < nr; i++) { @@ -402,7 +444,7 @@ value stub_xl_domain_sched_params_get(va ret = libxl_domain_sched_params_get(CTX, Int_val(domid), &c_scinfo); if (ret != 0) - failwith_xl("domain_sched_params_get"); + failwith_xl(ret, "domain_sched_params_get"); scinfo = Val_domain_sched_params(CTX, &c_scinfo); @@ -424,7 +466,7 @@ value stub_xl_domain_sched_params_set(va libxl_domain_sched_params_dispose(&c_scinfo); if (ret != 0) - failwith_xl("domain_sched_params_set"); + failwith_xl(ret, "domain_sched_params_set"); CAMLreturn(Val_unit); } @@ -441,7 +483,7 @@ value stub_xl_send_trigger(value ctx, va c_trigger, Int_val(vcpuid)); if (ret != 0) - failwith_xl("send_trigger"); + failwith_xl(ret, "send_trigger"); CAMLreturn(Val_unit); } @@ -454,7 +496,7 @@ value stub_xl_send_sysrq(value ctx, valu ret = libxl_send_sysrq(CTX, Int_val(domid), Int_val(sysrq)); if (ret != 0) - failwith_xl("send_sysrq"); + failwith_xl(ret, "send_sysrq"); CAMLreturn(Val_unit); } @@ -469,7 +511,7 @@ value stub_xl_send_debug_keys(value ctx, ret = libxl_send_debug_keys(CTX, c_keys); if (ret != 0) - failwith_xl("send_debug_keys"); + failwith_xl(ret, "send_debug_keys"); free(c_keys); diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/Makefile --- a/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000 +++ b/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000 @@ -6,9 +6,9 @@ OCAMLINCLUDE += \ -I $(OCAML_TOPLEVEL)/libs/xentoollog \ -I $(OCAML_TOPLEVEL)/libs/xl -OBJS = xtl send_debug_keys list_domains +OBJS = xtl send_debug_keys list_domains raise_exception -PROGRAMS = xtl send_debug_keys list_domains +PROGRAMS = xtl send_debug_keys list_domains raise_exception xtl_LIBS = \ -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa @@ -27,7 +27,13 @@ list_domains_LIBS = \ list_domains_OBJS = list_domains -OCAML_PROGRAM = xtl send_debug_keys list_domains +raise_exception_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 + +raise_exception_OBJS = raise_exception + +OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception all: $(PROGRAMS) diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/list_domains.ml --- a/tools/ocaml/test/list_domains.ml Tue Nov 20 17:22:21 2012 +0000 +++ b/tools/ocaml/test/list_domains.ml Tue Nov 20 17:22:21 2012 +0000 @@ -19,8 +19,11 @@ let print_dominfo dominfo = let _ = let logger = Xentoollog.create_stdio_logger (*~level:Xentoollog.Debug*) () in let ctx = Xenlight.ctx_alloc logger in - let domains = Xenlight.list_domain ctx in - List.iter (fun d -> print_dominfo d) domains; - Xenlight.ctx_free ctx; - Xentoollog.destroy logger; - + try + let domains = Xenlight.list_domain ctx in + List.iter (fun d -> print_dominfo d) domains; + Xenlight.ctx_free ctx; + Xentoollog.destroy logger; + with Xenlight.Error(err, fn) -> begin + printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) fn; + end diff -r e4525795eac2 -r c8d22bfef298 tools/ocaml/test/raise_exception.ml --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tools/ocaml/test/raise_exception.ml Tue Nov 20 17:22:21 2012 +0000 @@ -0,0 +1,15 @@ +open Printf +open Xentoollog +open Xenlight + +let _ = + let logger = Xentoollog.create_stdio_logger (*~level:Xentoollog.Debug*) () in + let ctx = Xenlight.ctx_alloc logger in + try + Xenlight.test_raise_exception () + with Xenlight.Error(err, fn) -> begin + printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) fn; + end; + Xenlight.ctx_free ctx; + Xentoollog.destroy logger; + _______________________________________________ Xen-api mailing list Xen-api@xxxxxxxxxxxxx http://lists.xen.org/cgi-bin/mailman/listinfo/xen-api
|
Lists.xenproject.org is hosted with RackSpace, monitoring our |