[PATCH v2 0/4] OCaml bindings for hvm_param_get and xc_evtchn_status

[PATCH v2 0/4] OCaml bindings for hvm_param_get and xc_evtchn_status

[Edwin Török]

Changes since v1:
* dropped stdint.h patch, still being discussed on where to best fix it
* addressed review comments (see individual patches' changes section)

Edwin Török (4):
  CODING-STYLE: add .editorconfig to clarify indentation uses spaces
  tools/ocaml/libs/xc: add binding to xc_evtchn_status
  tools/ocaml/libs/xc: add hvm_param_get binding
  tools/ocaml: add .clang-format

 .editorconfig                       | 20 ++++++
 tools/ocaml/.clang-format           |  9 +++
 tools/ocaml/libs/Makefile           |  2 +-
 tools/ocaml/libs/xc/META.in         |  2 +-
 tools/ocaml/libs/xc/Makefile        |  2 +-
 tools/ocaml/libs/xc/xenctrl.ml      | 62 ++++++++++++++++++
 tools/ocaml/libs/xc/xenctrl.mli     | 63 ++++++++++++++++++
 tools/ocaml/libs/xc/xenctrl_stubs.c | 99 +++++++++++++++++++++++++++++
 8 files changed, 256 insertions(+), 3 deletions(-)
 create mode 100644 .editorconfig
 create mode 100644 tools/ocaml/.clang-format

-- 
2.34.1

[PATCH v2 1/4] CODING-STYLE: add .editorconfig to clarify indentation uses spaces

[Edwin Török]

Add an .editorconfig to make it easier to keep patches compatible with
Xen's coding style, and to reemphasize what Xen's coding style is.

I thought that Xen demands tabs rather than spaces (which is more
difficult with OCaml because indentation tools use spaces,
and the use of tabs requires changing editor settings),
however CODING-STYLE says it is spaces.

Document this explicitly by adding a .editorconfig file (see editorconfig.org),
which is an editor agnostic format for specifying basic style properties like
indentation, either with native support in editors or via plugins.

It is safer than modelines because it only supports controlling a
restricted set of editor properties and not arbitrary commands as Vim
modelines would have, and works with editors other than Vim too.
(Vim has a deny list for modeline sandboxing, which is error-prone
because every time a new command gets added it needs to be added to the
deny list, which has been the source of a few CVEs in the past
and I disable Vim modelines everywhere as a precaution).

This file is added as a convenience for those who might have an editor
that supports it, and its presence should have no impact on those that
do not (want to) use it.
It also won't cause re-indentation of existing files when edited, only
newly added lines would follow the convention.

No functional change.

Signed-off-by: Edwin Török <edvin.torok@citrix.com>
---
 .editorconfig | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)
 create mode 100644 .editorconfig

diff --git a/.editorconfig b/.editorconfig
new file mode 100644
index 0000000000..cb2f27c581
--- /dev/null
+++ b/.editorconfig
@@ -0,0 +1,20 @@
+# See ./CODING_STYLE
+root = true
+
+[*]
+end_of_line = lf
+indent_style = space
+charset = utf-8
+max_line_length = 79
+trim_trailing_whitespace = true
+insert_final_newline = true
+
+# Makefiles must use tabs, otherwise they don't work
+[{Makefile,*.mk,Makefile.rules}]
+indent_style = tabs
+
+[*.{c,h}]
+indent_size = 4
+
+[*.{ml,mli}]
+indent_size = 2
-- 
2.34.1

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

[Edwin Török]

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@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://github.com/ocaml/ocaml/blob/663e8d219f566095e3a9497c5bae07b6a95cae39/otherlibs/unix/dup_win32.c#L52-L77
* 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);
+
+    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

[PATCH v2 3/4] tools/ocaml/libs/xc: add hvm_param_get binding

[Edwin Török]

Not to be confused which hvm_get_param, which also exists and has a
different, more error-prone interface.

This one always returns a 64-bit value, and that is retained in the
OCaml binding as well, returning 'int64' (and not int, or nativeint
which might have a different size).

The integer here is unsigned in the C API, however OCaml only has signed integers.

No bits are lost, it is just a matter of interpretation when printing
and for certain arithmetic operations, however in the cases where the
MSB is set it is very likely that the value is an address and no
arithmetic should be performed on the OCaml side on it.
(this is not a new problem with this binding, but worth mentioning given
the difference in types)

Signed-off-by: Edwin Török <edvin.torok@citrix.com>
---
Changes since v1:
* drop accidental extra numbers in variant names
* use 'val' instead of 'result' for local var
* add binding for hvm_param_set
---
 tools/ocaml/libs/xc/xenctrl.ml      | 47 ++++++++++++++++++++++++++++
 tools/ocaml/libs/xc/xenctrl.mli     | 48 +++++++++++++++++++++++++++++
 tools/ocaml/libs/xc/xenctrl_stubs.c | 32 +++++++++++++++++++
 3 files changed, 127 insertions(+)

diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml
index 5dac47991e..370dac3fc8 100644
--- a/tools/ocaml/libs/xc/xenctrl.ml
+++ b/tools/ocaml/libs/xc/xenctrl.ml
@@ -299,6 +299,53 @@ external map_foreign_range: handle -> domid -> int
   -> nativeint -> Xenmmap.mmap_interface
   = "stub_map_foreign_range"
 
+type hvm_param =
+  | HVM_PARAM_CALLBACK_IRQ
+  | HVM_PARAM_STORE_PFN
+  | HVM_PARAM_STORE_EVTCHN
+  | HVM_PARAM_UNDEF_3
+  | HVM_PARAM_PAE_ENABLED
+  | HVM_PARAM_IOREQ_PFN
+  | HVM_PARAM_BUFIOREQ_PFN
+  | HVM_PARAM_UNDEF_7
+  | HVM_PARAM_UNDEF_8
+  | HVM_PARAM_VIRIDIAN
+  | HVM_PARAM_TIMER_MODE0
+  | HVM_PARAM_HPET_ENABLED1
+  | HVM_PARAM_IDENT_PT2
+  | HVM_PARAM_UNDEF_13
+  | HVM_PARAM_ACPI_S_STATE
+  | HVM_PARAM_VM86_TSS
+  | HVM_PARAM_VPT_ALIGN
+  | HVM_PARAM_CONSOLE_PFN
+  | HVM_PARAM_CONSOLE_EVTCHN
+  | HVM_PARAM_ACPI_IOPORTS_LOCATION
+  | HVM_PARAM_MEMORY_EVENT_CR0
+  | HVM_PARAM_MEMORY_EVENT_CR3
+  | HVM_PARAM_MEMORY_EVENT_CR4
+  | HVM_PARAM_MEMORY_EVENT_INT3
+  | HVM_PARAM_NESTEDHVM
+  | HVM_PARAM_MEMORY_EVENT_SINGLE_STEP
+  | HVM_PARAM_UNDEF_26
+  | HVM_PARAM_PAGING_RING_PFN
+  | HVM_PARAM_MONITOR_RING_PFN
+  | HVM_PARAM_SHARING_RING_PFN
+  | HVM_PARAM_MEMORY_EVENT_MSR
+  | HVM_PARAM_TRIPLE_FAULT_REASON
+  | HVM_PARAM_IOREQ_SERVER_PFN
+  | HVM_PARAM_NR_IOREQ_SERVER_PAGES
+  | HVM_PARAM_VM_GENERATION_ID_ADDR
+  | HVM_PARAM_ALTP2M
+  | HVM_PARAM_X87_FIP_WIDTH6
+  | HVM_PARAM_VM86_TSS_SIZED
+  | HVM_PARAM_MCA_CAP
+
+external hvm_param_get: handle -> domid -> hvm_param -> int64
+  = "stub_xc_hvm_param_get"
+
+external hvm_param_set: handle -> domid -> hvm_param -> int64 -> unit
+  = "stub_xc_hvm_param_set"
+
 external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit
   = "stub_xc_domain_assign_device"
 external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit
diff --git a/tools/ocaml/libs/xc/xenctrl.mli b/tools/ocaml/libs/xc/xenctrl.mli
index 6c9206bc74..e18d5cddb7 100644
--- a/tools/ocaml/libs/xc/xenctrl.mli
+++ b/tools/ocaml/libs/xc/xenctrl.mli
@@ -236,6 +236,54 @@ external map_foreign_range :
   handle -> domid -> int -> nativeint -> Xenmmap.mmap_interface
   = "stub_map_foreign_range"
 
+(* needs to be sorted according to its numeric value, watch out for gaps! *)
+type hvm_param =
+  | HVM_PARAM_CALLBACK_IRQ
+  | HVM_PARAM_STORE_PFN
+  | HVM_PARAM_STORE_EVTCHN
+  | HVM_PARAM_UNDEF_3
+  | HVM_PARAM_PAE_ENABLED
+  | HVM_PARAM_IOREQ_PFN
+  | HVM_PARAM_BUFIOREQ_PFN
+  | HVM_PARAM_UNDEF_7
+  | HVM_PARAM_UNDEF_8
+  | HVM_PARAM_VIRIDIAN
+  | HVM_PARAM_TIMER_MODE0
+  | HVM_PARAM_HPET_ENABLED1
+  | HVM_PARAM_IDENT_PT2
+  | HVM_PARAM_UNDEF_13
+  | HVM_PARAM_ACPI_S_STATE
+  | HVM_PARAM_VM86_TSS
+  | HVM_PARAM_VPT_ALIGN
+  | HVM_PARAM_CONSOLE_PFN
+  | HVM_PARAM_CONSOLE_EVTCHN
+  | HVM_PARAM_ACPI_IOPORTS_LOCATION
+  | HVM_PARAM_MEMORY_EVENT_CR0
+  | HVM_PARAM_MEMORY_EVENT_CR3
+  | HVM_PARAM_MEMORY_EVENT_CR4
+  | HVM_PARAM_MEMORY_EVENT_INT3
+  | HVM_PARAM_NESTEDHVM
+  | HVM_PARAM_MEMORY_EVENT_SINGLE_STEP
+  | HVM_PARAM_UNDEF_26
+  | HVM_PARAM_PAGING_RING_PFN
+  | HVM_PARAM_MONITOR_RING_PFN
+  | HVM_PARAM_SHARING_RING_PFN
+  | HVM_PARAM_MEMORY_EVENT_MSR
+  | HVM_PARAM_TRIPLE_FAULT_REASON
+  | HVM_PARAM_IOREQ_SERVER_PFN
+  | HVM_PARAM_NR_IOREQ_SERVER_PAGES
+  | HVM_PARAM_VM_GENERATION_ID_ADDR
+  | HVM_PARAM_ALTP2M
+  | HVM_PARAM_X87_FIP_WIDTH6
+  | HVM_PARAM_VM86_TSS_SIZED
+  | HVM_PARAM_MCA_CAP
+
+external hvm_param_get: handle -> domid -> hvm_param -> int64
+  = "stub_xc_hvm_param_get"
+
+external hvm_param_set: handle -> domid -> hvm_param -> int64 -> unit
+  = "stub_xc_hvm_param_set"
+
 external domain_assign_device: handle -> domid -> (int * int * int * int) -> unit
   = "stub_xc_domain_assign_device"
 external domain_deassign_device: handle -> domid -> (int * int * int * int) -> unit
diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c b/tools/ocaml/libs/xc/xenctrl_stubs.c
index a492ea17fd..d042edb495 100644
--- a/tools/ocaml/libs/xc/xenctrl_stubs.c
+++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
@@ -1178,6 +1178,38 @@ CAMLprim value stub_xc_domain_irq_permission(value xch, value domid,
     CAMLreturn(Val_unit);
 }
 
+CAMLprim value stub_xc_hvm_param_get(value xch, value domid, value param)
+{
+    CAMLparam3(xch, domid, param);
+    uint64_t val;
+    int ret;
+
+    caml_enter_blocking_section();
+    ret = xc_hvm_param_get(_H(xch), _D(domid), Int_val(param), &val);
+    caml_leave_blocking_section();
+
+    if ( ret )
+        failwith_xc(_H(xch));
+
+    CAMLreturn(caml_copy_int64(val));
+}
+
+CAMLprim value stub_xc_hvm_param_set(value xch, value domid, value param, value val)
+{
+    CAMLparam4(xch, domid, param, val);
+    int ret;
+
+    caml_enter_blocking_section();
+    ret = xc_hvm_param_set(_H(xch), _D(domid), Int_val(param), Int64_val(val));
+    caml_leave_blocking_section();
+
+    if ( ret )
+        failwith_xc(_H(xch));
+
+    CAMLreturn(Val_unit);
+}
+
+
 static uint32_t encode_sbdf(int domain, int bus, int dev, int func)
 {
     return  ((uint32_t)domain & 0xffff) << 16 |
-- 
2.34.1

[PATCH v2 4/4] tools/ocaml: add .clang-format

[Edwin Török]

Add a .clang-format configuration that tries to match CODING_STYLE where
possible.

I was not able to express the special casing of braces after 'do'
though, this can only be controlled generally for all control
statements.
It is imperfect, but should be better than the existing bindings, which
do not follow Xen coding style.

Add this to tools/ocaml first because:
* there are relatively few C files here, and it is a good place to start with
* it'd be useful to make these follow Xen's CODING_STYLE
(which they currently do not because they use tabs for example)
* they change relatively infrequently, so shouldn't cause issues with
  backporting security fixes (could either backport the reindentation
  patch too, or use git cherry-pick with `-Xignore-space-change`)

Does not yet reformat any code.

No functional change.

Signed-off-by: Edwin Török <edvin.torok@citrix.com>
Acked-by: Christian Lindig <christian.lindig@citrix.com>
---
Changes since v1:
* change commit title to reflect this is for OCaml subtree only
* don't mention stdint.h here, that may be fixed in a different way elsewhere
---
 tools/ocaml/.clang-format | 9 +++++++++
 1 file changed, 9 insertions(+)
 create mode 100644 tools/ocaml/.clang-format

diff --git a/tools/ocaml/.clang-format b/tools/ocaml/.clang-format
new file mode 100644
index 0000000000..7ff88ee043
--- /dev/null
+++ b/tools/ocaml/.clang-format
@@ -0,0 +1,9 @@
+BasedOnStyle: GNU
+IndentWidth: 4
+
+# override GNU to match Xen ../../CODING_STYLE more closely
+AlwaysBreakAfterDefinitionReturnType: None
+AlwaysBreakAfterReturnType: None
+SpacesInConditionalStatement: true
+SpaceBeforeParens: ControlStatements
+BreakBeforeBraces: Allman
-- 
2.34.1

Re: [PATCH v2 3/4] tools/ocaml/libs/xc: add hvm_param_get binding

[Andrew Cooper]

On 02/12/2022 10:55, Edwin Török wrote:
> Not to be confused which hvm_get_param, which also exists and has a
> different, more error-prone interface.
>
> This one always returns a 64-bit value, and that is retained in the
> OCaml binding as well, returning 'int64' (and not int, or nativeint
> which might have a different size).
>
> The integer here is unsigned in the C API, however OCaml only has signed integers.
>
> No bits are lost, it is just a matter of interpretation when printing
> and for certain arithmetic operations, however in the cases where the
> MSB is set it is very likely that the value is an address and no
> arithmetic should be performed on the OCaml side on it.
> (this is not a new problem with this binding, but worth mentioning given
> the difference in types)
>
> Signed-off-by: Edwin Török <edvin.torok@citrix.com>

Reviewed-by: Andrew Cooper <andrew.cooper3@citrix.com>

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

[Andrew Cooper]

On 02/12/2022 10:55, Edwin Török wrote:
> 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
> @@ -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);
> +
> +    switch ( status.status )
> +    {

The EVTCHNSTAT_closed wants to be a case here, otherwise it's really
weird to read from a C point of view.

It would be fine to have a comment like this:

case EVTCHNSTAT_closed:
    CAMLreturn(Val_none); /* Early exit, no allocations needed. */

to help identify more clearly that this a bit of a special case.

> +    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;

Newline here.

> +    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
> +     */

I'd just drop this comment.  It's going to be many many years before
Ocaml 4.12 drops off the bottom of the support list, so this observation
is unactionable.

All 3 of these are trivial to fix on commit, so Reviewed-by: Andrew
Cooper <andrew.cooper3@citrix.com> otherwise.

~Andrew

Re: [PATCH v2 3/4] tools/ocaml/libs/xc: add hvm_param_get binding

[Christian Lindig]

> On 2 Dec 2022, at 10:55, Edwin Török <edvin.torok@citrix.com> wrote:
> 
> Not to be confused which hvm_get_param, which also exists and has a
> different, more error-prone interface.
> 
> This one always returns a 64-bit value, and that is retained in the
> OCaml binding as well, returning 'int64' (and not int, or nativeint
> which might have a different size).
> 
> The integer here is unsigned in the C API, however OCaml only has signed integers.
> 
> No bits are lost, it is just a matter of interpretation when printing
> and for certain arithmetic operations, however in the cases where the
> MSB is set it is very likely that the value is an address and no
> arithmetic should be performed on the OCaml side on it.
> (this is not a new problem with this binding, but worth mentioning given
> the difference in types)
> 
> Signed-off-by: Edwin Török <edvin.torok@citrix.com>

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

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

[Christian Lindig]

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

Acked-by: Christian Lindig <christian.lindig@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&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
>