Mailing List Archive

[xen master] tools/ocaml/xenctrl: Add binding for xc_evtchn_status
commit ff95dae53e5e41d9a428143e0cb14b4467c123fd
Author: Edwin Török <edvin.torok@citrix.com>
AuthorDate: Fri Dec 2 10:55:57 2022 +0000
Commit: Andrew Cooper <andrew.cooper3@citrix.com>
CommitDate: Fri Dec 2 13:41:04 2022 +0000

tools/ocaml/xenctrl: Add binding for xc_evtchn_status

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. This causes the xc bindings to now depend on
evtchn to get a useful API for EVTCHNSTAT_virq.

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.torok@citrix.com>
Reviewed-by: Andrew Cooper <andrew.cooper3@citrix.com>
Acked-by: Christian Lindig <christian.lindig@citrix.com>
---
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 | 66 +++++++++++++++++++++++++++++++++++++
6 files changed, 99 insertions(+), 3 deletions(-)

diff --git a/tools/ocaml/libs/Makefile b/tools/ocaml/libs/Makefile
index 7e7c27e2d5..5146c52484 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 4b74e31c75..b70ab89caa 100644
--- a/tools/ocaml/libs/xc/xenctrl.ml
+++ b/tools/ocaml/libs/xc/xenctrl.ml
@@ -277,6 +277,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 ddfe84dc22..f6a777ede6 100644
--- a/tools/ocaml/libs/xc/xenctrl.mli
+++ b/tools/ocaml/libs/xc/xenctrl.mli
@@ -205,6 +205,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 4e12040854..9cbf17103d 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
+
static void stub_xenctrl_finalize(value v)
{
xc_interface_close(_H(v));
@@ -649,6 +653,68 @@ 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));
+
+ switch ( status.status )
+ {
+ case EVTCHNSTAT_closed:
+ CAMLreturn(Val_none); /* Early exit, no allocations needed */
+
+ 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);
+
+ result = caml_alloc_small(1, Tag_some);
+ Store_field(result, 0, result_status);
+
+ CAMLreturn(result);
+}

CAMLprim value stub_xc_readconsolering(value xch)
{
--
generated by git-patchbot for /home/xen/git/xen.git#master