> On 2 Dec 2022, at 10:55, Edwin Török <edvin.to...@citrix.com> wrote: > > There is no API or ioctl to query event channel status, it is only > present in xenctrl.h > > The C union is mapped to an OCaml variant exposing just the value from the > correct union tag. > > The information provided here is similar to 'lsevtchn', but rather than > parsing its output it queries the underlying API directly. > > Signed-off-by: Edwin Török <edvin.to...@citrix.com>
Acked-by: Christian Lindig <christian.lin...@citrix.com> > --- > Changes since v1: > * drop paragraph about where this is used > * add comment about max port > * use Xeneventchn.virq_t instead of int, add a dependency: xc -> eventchn > * initialize struct without memset-ing first > * use 2 CAMLreturn, I found an example in the OCaml stdlib that does that so > should be future-proof > https://nam04.safelinks.protection.outlook.com/?url=https%3A%2F%2Fgithub.com%2Focaml%2Focaml%2Fblob%2F663e8d219f566095e3a9497c5bae07b6a95cae39%2Fotherlibs%2Funix%2Fdup_win32.c%23L52-L77&data=05%7C01%7Cchristian.lindig%40citrix.com%7C7d476fd71ea14746b08f08dad453d946%7C335836de42ef43a2b145348c2ee9ca5b%7C0%7C0%7C638055753844059822%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000%7C%7C%7C&sdata=c97tdCv0VPS7UBPoLJXf3geZKQq0AkhjWuA1wq2ZUW0%3D&reserved=0 > * use Tag_some, defining it if needed > * fix typo on failwith > --- > tools/ocaml/libs/Makefile | 2 +- > tools/ocaml/libs/xc/META.in | 2 +- > tools/ocaml/libs/xc/Makefile | 2 +- > tools/ocaml/libs/xc/xenctrl.ml | 15 +++++++ > tools/ocaml/libs/xc/xenctrl.mli | 15 +++++++ > tools/ocaml/libs/xc/xenctrl_stubs.c | 67 +++++++++++++++++++++++++++++ > 6 files changed, 100 insertions(+), 3 deletions(-) > > diff --git a/tools/ocaml/libs/Makefile b/tools/ocaml/libs/Makefile > index 7e7c27e2d5..15f45a6d66 100644 > --- a/tools/ocaml/libs/Makefile > +++ b/tools/ocaml/libs/Makefile > @@ -4,7 +4,7 @@ include $(XEN_ROOT)/tools/Rules.mk > SUBDIRS= \ > mmap \ > xentoollog \ > - xc eventchn \ > + eventchn xc\ > xb xs xl > > .PHONY: all > diff --git a/tools/ocaml/libs/xc/META.in b/tools/ocaml/libs/xc/META.in > index 2ff4dcb6bf..6a273936a3 100644 > --- a/tools/ocaml/libs/xc/META.in > +++ b/tools/ocaml/libs/xc/META.in > @@ -1,5 +1,5 @@ > version = "@VERSION@" > description = "Xen Control Interface" > -requires = "unix,xenmmap" > +requires = "unix,xenmmap,xeneventchn" > archive(byte) = "xenctrl.cma" > archive(native) = "xenctrl.cmxa" > diff --git a/tools/ocaml/libs/xc/Makefile b/tools/ocaml/libs/xc/Makefile > index 3b76e9ad7b..1d9fecb06e 100644 > --- a/tools/ocaml/libs/xc/Makefile > +++ b/tools/ocaml/libs/xc/Makefile > @@ -4,7 +4,7 @@ include $(OCAML_TOPLEVEL)/common.make > > CFLAGS += -I../mmap $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest) > CFLAGS += $(APPEND_CFLAGS) > -OCAMLINCLUDE += -I ../mmap > +OCAMLINCLUDE += -I ../mmap -I ../eventchn > > OBJS = xenctrl > INTF = xenctrl.cmi > diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml > index 2ed7454b16..5dac47991e 100644 > --- a/tools/ocaml/libs/xc/xenctrl.ml > +++ b/tools/ocaml/libs/xc/xenctrl.ml > @@ -267,6 +267,21 @@ external evtchn_alloc_unbound: handle -> domid -> domid > -> int > = "stub_xc_evtchn_alloc_unbound" > external evtchn_reset: handle -> domid -> unit = "stub_xc_evtchn_reset" > > +(* FIFO has theoretical maximum of 2^28 ports, fits in an int *) > +type evtchn_interdomain = { dom: domid; port: int} > + > +type evtchn_stat = > + | EVTCHNSTAT_unbound of domid > + | EVTCHNSTAT_interdomain of evtchn_interdomain > + | EVTCHNSTAT_pirq of int > + | EVTCHNSTAT_virq of Xeneventchn.virq_t > + | EVTCHNSTAT_ipi > + > +type evtchn_status = { vcpu: int; status: evtchn_stat } > + > +external evtchn_status: handle -> domid -> int -> evtchn_status option = > + "stub_xc_evtchn_status" > + > external readconsolering: handle -> string = "stub_xc_readconsolering" > > external send_debug_keys: handle -> string -> unit = "stub_xc_send_debug_keys" > diff --git a/tools/ocaml/libs/xc/xenctrl.mli b/tools/ocaml/libs/xc/xenctrl.mli > index 0f80aafea0..6c9206bc74 100644 > --- a/tools/ocaml/libs/xc/xenctrl.mli > +++ b/tools/ocaml/libs/xc/xenctrl.mli > @@ -206,6 +206,21 @@ external shadow_allocation_get : handle -> domid -> int > external evtchn_alloc_unbound : handle -> domid -> domid -> int > = "stub_xc_evtchn_alloc_unbound" > external evtchn_reset : handle -> domid -> unit = "stub_xc_evtchn_reset" > + > +type evtchn_interdomain = { dom: domid; port: int} > + > +type evtchn_stat = > + | EVTCHNSTAT_unbound of domid > + | EVTCHNSTAT_interdomain of evtchn_interdomain > + | EVTCHNSTAT_pirq of int > + | EVTCHNSTAT_virq of Xeneventchn.virq_t > + | EVTCHNSTAT_ipi > + > +type evtchn_status = { vcpu: int; status: evtchn_stat } > + > +external evtchn_status: handle -> domid -> int -> evtchn_status option = > + "stub_xc_evtchn_status" > + > external readconsolering : handle -> string = "stub_xc_readconsolering" > external send_debug_keys : handle -> string -> unit = > "stub_xc_send_debug_keys" > external physinfo : handle -> physinfo = "stub_xc_physinfo" > diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c > b/tools/ocaml/libs/xc/xenctrl_stubs.c > index d30585f21c..a492ea17fd 100644 > --- a/tools/ocaml/libs/xc/xenctrl_stubs.c > +++ b/tools/ocaml/libs/xc/xenctrl_stubs.c > @@ -44,6 +44,10 @@ > #define Val_none (Val_int(0)) > #endif > > +#ifndef Tag_some > +#define Tag_some 0 > +#endif > + > #define string_of_option_array(array, index) \ > ((Field(array, index) == Val_none) ? NULL : String_val(Field(Field(array, > index), 0))) > > @@ -641,6 +645,69 @@ CAMLprim value stub_xc_evtchn_reset(value xch, value > domid) > CAMLreturn(Val_unit); > } > > +CAMLprim value stub_xc_evtchn_status(value xch, value domid, value port) > +{ > + CAMLparam3(xch, domid, port); > + CAMLlocal4(result, result_status, stat, interdomain); > + xc_evtchn_status_t status = { > + .dom = _D(domid), > + .port = Int_val(port), > + }; > + int rc; > + > + caml_enter_blocking_section(); > + rc = xc_evtchn_status(_H(xch), &status); > + caml_leave_blocking_section(); > + > + if ( rc < 0 ) > + failwith_xc(_H(xch)); > + > + if ( status.status == EVTCHNSTAT_closed ) > + CAMLreturn(Val_none); Could this case be handled in the switch, too? > + > + switch ( status.status ) > + { > + case EVTCHNSTAT_unbound: > + stat = caml_alloc(1, 0); /* 1st non-constant constructor */ > + Store_field(stat, 0, Val_int(status.u.unbound.dom)); > + break; > + > + case EVTCHNSTAT_interdomain: > + interdomain = caml_alloc_tuple(2); > + Store_field(interdomain, 0, Val_int(status.u.interdomain.dom)); > + Store_field(interdomain, 1, Val_int(status.u.interdomain.port)); > + stat = caml_alloc(1, 1); /* 2nd non-constant constructor */ > + Store_field(stat, 0, interdomain); > + break; > + case EVTCHNSTAT_pirq: > + stat = caml_alloc(1, 2); /* 3rd non-constant constructor */ > + Store_field(stat, 0, Val_int(status.u.pirq)); > + break; > + > + case EVTCHNSTAT_virq: > + stat = caml_alloc(1, 3); /* 4th non-constant constructor */ > + Store_field(stat, 0, Val_int(status.u.virq)); > + break; > + > + case EVTCHNSTAT_ipi: > + stat = Val_int(0); /* 1st constant constructor */ > + break; > + > + default: > + caml_failwith("Unknown evtchn status"); > + > + } > + result_status = caml_alloc_tuple(2); > + Store_field(result_status, 0, Val_int(status.vcpu)); > + Store_field(result_status, 1, stat); > + > + /* caml_alloc_some is missing in older versions of OCaml > + */ > + result = caml_alloc_small(1, Tag_some); > + Store_field(result, 0, result_status); > + > + CAMLreturn(result); > +} > > CAMLprim value stub_xc_readconsolering(value xch) > { > -- > 2.34.1 >
