diff mbox series

[v1,2/5] tools/ocaml/libs/xc: add binding to xc_evtchn_status

Message ID 4daa8daa6398774e5cb0a90c30648c970faed6af.1669829264.git.edvin.torok@citrix.com (mailing list archive)
State Superseded
Headers show
Series OCaml bindings for hvm_param_get and xc_evtchn_status | expand

Commit Message

Edwin Török Nov. 30, 2022, 5:32 p.m. UTC
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.

Querying event channel status is useful when analyzing Windows VMs that
may have reset and changed the xenstore event channel port number from
what it initially got booted with.
The information provided here is similar to 'lstevtchn', but rather than
parsing its output it queries the underlying API directly.

Signed-off-by: Edwin Török <edvin.torok@citrix.com>
---
 tools/ocaml/libs/xc/xenctrl.ml      | 14 +++++++
 tools/ocaml/libs/xc/xenctrl.mli     | 15 +++++++
 tools/ocaml/libs/xc/xenctrl_stubs.c | 65 +++++++++++++++++++++++++++++
 3 files changed, 94 insertions(+)

Comments

Andrew Cooper Dec. 1, 2022, 11:34 a.m. UTC | #1
On 30/11/2022 17:32, Edwin Török wrote:
> There is no API or ioctl to query event channel status, it is only
> present in xenctrl.h

Yeah, this is very unfortunate, because it really wanted to be part of
the xenevtchn stable API/ABI.

> The C union is mapped to an OCaml variant exposing just the value from the
> correct union tag.
>
> Querying event channel status is useful when analyzing Windows VMs that
> may have reset and changed the xenstore event channel port number from
> what it initially got booted with.

This paragraph is why we need it now, but it's not really relevant for
the upstream commit.  I'd drop this sentence, and simply how the lower
one noting the similarity to lsevtchn.

> The information provided here is similar to 'lstevtchn', but rather than

"lsevtchn".

> parsing its output it queries the underlying API directly.
>
> Signed-off-by: Edwin Török <edvin.torok@citrix.com>
> ---
>  tools/ocaml/libs/xc/xenctrl.ml      | 14 +++++++
>  tools/ocaml/libs/xc/xenctrl.mli     | 15 +++++++
>  tools/ocaml/libs/xc/xenctrl_stubs.c | 65 +++++++++++++++++++++++++++++
>  3 files changed, 94 insertions(+)
>
> diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml
> index 2ed7454b16..c21e391f98 100644
> --- a/tools/ocaml/libs/xc/xenctrl.ml
> +++ b/tools/ocaml/libs/xc/xenctrl.ml
> @@ -267,6 +267,20 @@ 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}

Strictly speaking, port needs to be int32.

ABI-wise, it can be configured as large as 2^32-2 during domain creation.

However, FIFO currently tops out at 2^17 and has a theoretical maximum
at 2^28, so perhaps int ought to enough for now.

> +
> +type evtchn_stat =
> +  | EVTCHNSTAT_unbound of domid
> +  | EVTCHNSTAT_interdomain of evtchn_interdomain
> +  | EVTCHNSTAT_pirq of int
> +  | EVTCHNSTAT_virq of int

Similar comment.  A vcpu id should in principle be int32

> +  | EVTCHNSTAT_ipi

Normally when having an enumeration like this, we want to hook up the
build-time ABI check.

But in this case, it's produced by the bindings (not consumed by them),
and there's an exception raised in the default case, so I don't think we
need the build-time ABI check for any kind of safety (and therefore
shouldn't go to the reasonably-invasive effort of adding the check).

> diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c b/tools/ocaml/libs/xc/xenctrl_stubs.c
> index d30585f21c..67f3648391 100644
> --- a/tools/ocaml/libs/xc/xenctrl_stubs.c
> +++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
> @@ -641,6 +641,71 @@ 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;
> +    int rc;
> +
> +    memset(&status, 0, sizeof(status));
> +    status.dom = _D(domid);
> +    status.port = Int_val(port);

xc_evtchn_status_t status = {
    .dom = _D(domid),
    .port = Int_val(port),
};

is the marginally preferred way of doing this.  It removes potential
issues with typo-ing the memset().

> +
> +    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 )
> +        result = Val_none;
> +    else
> +    {

This is actually one example where using a second CAMLreturn would
simply things substantially.

switch ( status.status )
{
case EVTCHNSTAT_closed:
    CAMLreturn(Val_none);

case EVTCHNSTAT_unbound:
    ...

Would remove the need for the outer if/else.


> +        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("Unkown evtchn status");
> +        }

We'd normally have a blank line here.

> +        result_status = caml_alloc_tuple(2);
> +        Store_field(result_status, 0, Val_int(status.vcpu));
> +        Store_field(result_status, 1, stat);
> +
> +        /* Tag_some and caml_alloc_some are missing in older versions of OCaml
> +         */

Can we do the usual

#ifndef Tag_some
# define Tag_some ...
#endif

at the top, and use it unconditionally here?

caml_alloc_some() is perhaps less interesting as it only appeared in
Ocaml 4.12 AFAICT, but we could also have some ifdefary for that at the
top of the file.

I don't know whether we have opencoded options elsewhere in the
bindings, but it certainly would be reduce the amount opencoding that
exists for standard patterns.

~Andrew
Edwin Török Dec. 1, 2022, 1:35 p.m. UTC | #2
> On 1 Dec 2022, at 11:34, Andrew Cooper <Andrew.Cooper3@citrix.com> wrote:
> 
> On 30/11/2022 17:32, Edwin Török wrote:
>> There is no API or ioctl to query event channel status, it is only
>> present in xenctrl.h
> 
> Yeah, this is very unfortunate, because it really wanted to be part of
> the xenevtchn stable API/ABI.
> 
>> The C union is mapped to an OCaml variant exposing just the value from the
>> correct union tag.
>> 
>> Querying event channel status is useful when analyzing Windows VMs that
>> may have reset and changed the xenstore event channel port number from
>> what it initially got booted with.
> 
> This paragraph is why we need it now, but it's not really relevant for
> the upstream commit.  I'd drop this sentence, and simply how the lower
> one noting the similarity to lsevtchn.
> 
>> The information provided here is similar to 'lstevtchn', but rather than
> 
> "lsevtchn".
> 
>> parsing its output it queries the underlying API directly.
>> 
>> Signed-off-by: Edwin Török <edvin.torok@citrix.com>
>> ---
>> tools/ocaml/libs/xc/xenctrl.ml      | 14 +++++++
>> tools/ocaml/libs/xc/xenctrl.mli     | 15 +++++++
>> tools/ocaml/libs/xc/xenctrl_stubs.c | 65 +++++++++++++++++++++++++++++
>> 3 files changed, 94 insertions(+)
>> 
>> diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml
>> index 2ed7454b16..c21e391f98 100644
>> --- a/tools/ocaml/libs/xc/xenctrl.ml
>> +++ b/tools/ocaml/libs/xc/xenctrl.ml
>> @@ -267,6 +267,20 @@ 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}
> 
> Strictly speaking, port needs to be int32.
> 
> ABI-wise, it can be configured as large as 2^32-2 during domain creation.
> 
> However, FIFO currently tops out at 2^17 and has a theoretical maximum
> at 2^28, so perhaps int ought to enough for now.
> 
>> +
>> +type evtchn_stat =
>> +  | EVTCHNSTAT_unbound of domid
>> +  | EVTCHNSTAT_interdomain of evtchn_interdomain
>> +  | EVTCHNSTAT_pirq of int
>> +  | EVTCHNSTAT_virq of int
> 
> Similar comment.  A vcpu id should in principle be int32
> 
>> +  | EVTCHNSTAT_ipi
> 
> Normally when having an enumeration like this, we want to hook up the
> build-time ABI check.
> 
> But in this case, it's produced by the bindings (not consumed by them),
> and there's an exception raised in the default case, so I don't think we
> need the build-time ABI check for any kind of safety (and therefore
> shouldn't go to the reasonably-invasive effort of adding the check).

Yes, I was looking for how to add an ABI check there, but other places like the featureset enum doesn't have it either.
The ABI check only seems to exist for the case where the values are used as bit flags.

> 
>> diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c b/tools/ocaml/libs/xc/xenctrl_stubs.c
>> index d30585f21c..67f3648391 100644
>> --- a/tools/ocaml/libs/xc/xenctrl_stubs.c
>> +++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
>> @@ -641,6 +641,71 @@ 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;
>> +    int rc;
>> +
>> +    memset(&status, 0, sizeof(status));
>> +    status.dom = _D(domid);
>> +    status.port = Int_val(port);
> 
> xc_evtchn_status_t status = {
>     .dom = _D(domid),
>     .port = Int_val(port),
> };
> 
> is the marginally preferred way of doing this.  It removes potential
> issues with typo-ing the memset().
> 
>> +
>> +    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 )
>> +        result = Val_none;
>> +    else
>> +    {
> 
> This is actually one example where using a second CAMLreturn would
> simply things substantially.
> 
> switch ( status.status )
> {
> case EVTCHNSTAT_closed:
>     CAMLreturn(Val_none);
> 
> case EVTCHNSTAT_unbound:
>     ...
> 
> Would remove the need for the outer if/else.


CAMLreturn has some macro magic to ensure it gets paired with the toplevel CAMLparam correctly (one of them opens a { scope and the other closes it, or something like that),
so I'd avoid putting it into the middle of other syntactic elements, it might just cause the build to fail (either now or in the future).

> 
> 
>> +        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("Unkown evtchn status");
>> +        }
> 
> We'd normally have a blank line here.
> 
>> +        result_status = caml_alloc_tuple(2);
>> +        Store_field(result_status, 0, Val_int(status.vcpu));
>> +        Store_field(result_status, 1, stat);
>> +
>> +        /* Tag_some and caml_alloc_some are missing in older versions of OCaml
>> +         */
> 
> Can we do the usual
> 
> #ifndef Tag_some
> # define Tag_some ...
> #endif
> 
> at the top, and use it unconditionally here?


Yes to the other suggestions.

> 
> caml_alloc_some() is perhaps less interesting as it only appeared in
> Ocaml 4.12 AFAICT, but we could also have some ifdefary for that at the
> top of the file.
> 
> I don't know whether we have opencoded options elsewhere in the
> bindings, but it certainly would be reduce the amount opencoding that
> exists for standard patterns.


perhaps we can look into doing that cleanup as a separate patch.

Best regards,
--Edwin
Andrew Cooper Dec. 1, 2022, 1:59 p.m. UTC | #3
On 01/12/2022 13:35, Edwin Torok wrote:
>> On 1 Dec 2022, at 11:34, Andrew Cooper <Andrew.Cooper3@citrix.com> wrote:
>>
>> On 30/11/2022 17:32, Edwin Török wrote:
>>> +
>>> +    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 )
>>> +        result = Val_none;
>>> +    else
>>> +    {
>> This is actually one example where using a second CAMLreturn would
>> simply things substantially.
>>
>> switch ( status.status )
>> {
>> case EVTCHNSTAT_closed:
>>     CAMLreturn(Val_none);
>>
>> case EVTCHNSTAT_unbound:
>>     ...
>>
>> Would remove the need for the outer if/else.
>
> CAMLreturn has some macro magic to ensure it gets paired with the toplevel CAMLparam correctly (one of them opens a { scope and the other closes it, or something like that),
> so I'd avoid putting it into the middle of other syntactic elements, it might just cause the build to fail (either now or in the future).

From the manual:

"The macros CAMLreturn, CAMLreturn0, and CAMLreturnT are used to replace
the C keyword return. Every occurrence of return x must be replaced by ..."

It is common in C to have multiple returns, and the manual does say
"Every occurrence" without stating any requirement for there to be a
single occurrence.

CAMLreturn can't syntactically work splitting a scope with CAMLparam,
because then this wouldn't compile:

CAMLprim value stub_xc_evtchn_status(value foo)
{
    CAMLparam1(foo);
    int bar = 0;

retry:
    if ( bar )
        CAMLreturn(foo);

    bar++
    goto retry;
}

CAMLreturn does use a normal "do { ... } while (0)" construct simply for
being a macro, and forces paring with CAMLparamX by referencing the
caml__frame local variable by name.


So I really do think that multiple CAMLreturns are fine and cannot
reasonably be broken in the future.

But if we do really still want to keep a single return, then a "goto
done" would be acceptable here and still better than the if/else.

>> caml_alloc_some() is perhaps less interesting as it only appeared in
>> Ocaml 4.12 AFAICT, but we could also have some ifdefary for that at the
>> top of the file.
>>
>> I don't know whether we have opencoded options elsewhere in the
>> bindings, but it certainly would be reduce the amount opencoding that
>> exists for standard patterns.
>
> perhaps we can look into doing that cleanup as a separate patch.

Probably best, yes.

~Andrew
Edwin Török Dec. 1, 2022, 2:37 p.m. UTC | #4
> On 1 Dec 2022, at 13:59, Andrew Cooper <Andrew.Cooper3@citrix.com> wrote:
> 
> On 01/12/2022 13:35, Edwin Torok wrote:
>>> On 1 Dec 2022, at 11:34, Andrew Cooper <Andrew.Cooper3@citrix.com> wrote:
>>> 
>>> On 30/11/2022 17:32, Edwin Török wrote:
>>>> +
>>>> +    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 )
>>>> +        result = Val_none;
>>>> +    else
>>>> +    {
>>> This is actually one example where using a second CAMLreturn would
>>> simply things substantially.
>>> 
>>> switch ( status.status )
>>> {
>>> case EVTCHNSTAT_closed:
>>>    CAMLreturn(Val_none);
>>> 
>>> case EVTCHNSTAT_unbound:
>>>    ...
>>> 
>>> Would remove the need for the outer if/else.
>> 
>> CAMLreturn has some macro magic to ensure it gets paired with the toplevel CAMLparam correctly (one of them opens a { scope and the other closes it, or something like that),
>> so I'd avoid putting it into the middle of other syntactic elements, it might just cause the build to fail (either now or in the future).
> 
> From the manual:
> 
> "The macros CAMLreturn, CAMLreturn0, and CAMLreturnT are used to replace
> the C keyword return. Every occurrence of return x must be replaced by ..."
> 
> It is common in C to have multiple returns, and the manual does say
> "Every occurrence" without stating any requirement for there to be a
> single occurrence.
> 
> CAMLreturn can't syntactically work splitting a scope with CAMLparam,
> because then this wouldn't compile:
> 
> CAMLprim value stub_xc_evtchn_status(value foo)
> {
>     CAMLparam1(foo);
>     int bar = 0;
> 
> retry:
>     if ( bar )
>         CAMLreturn(foo);
> 
>     bar++
>     goto retry;
> }
> 


I wouldn't expect it to, or at least I've never seen a C binding written that way (with CAMLreturn not as last statement),
but indeed nothing in the manual states that it wouldn't work.

> CAMLreturn does use a normal "do { ... } while (0)" construct simply for
> being a macro, and forces paring with CAMLparamX by referencing the
> caml__frame local variable by name.
> 
> 
> So I really do think that multiple CAMLreturns are fine and cannot
> reasonably be broken in the future.
> 
> But if we do really still want to keep a single return, then a "goto
> done" would be acceptable here and still better than the if/else.

I almost always used to use do/while(0) and break even in C as a replacement for 'goto',
especially if there are multiple nested resources that need cleaning up, do/while ensures you
unwind them in the correct order and don't accidentally skip one.
I think most code that is written using 'goto' can be rewritten not to use it, and might avoid some bugs in the process
(e.g. using goto might leave some local variables uninitialised).
I'm reluctant to introduce a goto just to decrease nesting level.

There might be another way to rewrite the code:
```
switch(status.status)
{
case EVTCHNSTAT_closed:
 stat = Val_none;
 break;
... other code that assigns to stat something other than None ...
}

if (Val_none == stat) {
   result = Val_none;
} else {
   .. code as it was before to construct a some ...
}

CAMLreturn(result);
```

This would then follow the logical order of how the values are constructed, and avoids the deep nesting of the switch.
(reading the code backwards from exit will show you how each piece is nested/constructed without jumps that alter control flow)

Val_none == is used instead of == Val_none to catch a typo where stat = Val_none would change stat, whereas Val_none = stat would be a compile error.

What do you think?

(might be slightly less efficient than the original version, but a reasonable C compiler should produce almost equal optimized code for both).

> 
>>> caml_alloc_some() is perhaps less interesting as it only appeared in
>>> Ocaml 4.12 AFAICT, but we could also have some ifdefary for that at the
>>> top of the file.
>>> 
>>> I don't know whether we have opencoded options elsewhere in the
>>> bindings, but it certainly would be reduce the amount opencoding that
>>> exists for standard patterns.
>> 
>> perhaps we can look into doing that cleanup as a separate patch.
> 
> Probably best, yes.
> 
> ~Andrew
diff mbox series

Patch

diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml
index 2ed7454b16..c21e391f98 100644
--- a/tools/ocaml/libs/xc/xenctrl.ml
+++ b/tools/ocaml/libs/xc/xenctrl.ml
@@ -267,6 +267,20 @@  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 int
+  | 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..60e7902e66 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 int
+  | 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..67f3648391 100644
--- a/tools/ocaml/libs/xc/xenctrl_stubs.c
+++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
@@ -641,6 +641,71 @@  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;
+    int rc;
+
+    memset(&status, 0, sizeof(status));
+    status.dom = _D(domid);
+    status.port = Int_val(port);
+
+    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 )
+        result = Val_none;
+    else
+    {
+        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("Unkown evtchn status");
+        }
+        result_status = caml_alloc_tuple(2);
+        Store_field(result_status, 0, Val_int(status.vcpu));
+        Store_field(result_status, 1, stat);
+
+        /* Tag_some and caml_alloc_some are missing in older versions of OCaml
+         */
+        result = caml_alloc_small(1, 0);
+        Store_field(result, 0, result_status);
+    }
+
+    CAMLreturn(result);
+}
 
 CAMLprim value stub_xc_readconsolering(value xch)
 {