Re: [PATCH v2 2/4] tools/ocaml/libs/xc: add binding to xc_evtchn_status

[Christian Lindig <christian.lindig@xxxxxxxxxx>]

> On 2 Dec 2022, at 10:55, Edwin Török <edvin.torok@xxxxxxxxxx> 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.torok@xxxxxxxxxx>

Acked-by: Christian Lindig <christian.lindig@xxxxxxxxxx>

> ---
> 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&amp;data=05%7C01%7Cchristian.lindig%40citrix.com%7C7d476fd71ea14746b08f08dad453d946%7C335836de42ef43a2b145348c2ee9ca5b%7C0%7C0%7C638055753844059822%7CUnknown%7CTWFpbGZsb3d8eyJWIjoiMC4wLjAwMDAiLCJQIjoiV2luMzIiLCJBTiI6Ik1haWwiLCJXVCI6Mn0%3D%7C3000%7C%7C%7C&amp;sdata=c97tdCv0VPS7UBPoLJXf3geZKQq0AkhjWuA1wq2ZUW0%3D&amp;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
>