> On 23 Nov 2022, at 22:25, Andrew Cooper <[email protected]> wrote:
>
> The binding for xc_interface_close() free the underlying handle while leaving
> the Ocaml object still in scope and usable. This would make it easy to suffer
> a use-after-free, if it weren't for the fact that the typical usage is as a
> singleton that lives for the lifetime of the program.
>
> Ocaml 5 no longer permits storing a naked C pointer in an Ocaml value.
>
> Therefore, use a Custom block. This allows us to use the finaliser callback
> to call xc_interface_close(), if the Ocaml object goes out of scope.
>
> Signed-off-by: Andrew Cooper <[email protected]>
> ---
> CC: Christian Lindig <[email protected]>
> CC: David Scott <[email protected]>
> CC: Edwin Torok <[email protected]>
> CC: Rob Hoes <[email protected]>
>
> I've confirmed that Xenctrl.close_handle does cause the finaliser to be
> called, simply by dropping the handle reference.
Thanks, a good way to test this is with OCAMLRUNPARAM=c, possible under
valgrind, which causes all finalisers to be called on exit
(normally they are not because the program is exiting anyway)
> ---
> tools/ocaml/libs/xc/xenctrl.ml | 3 +--
> tools/ocaml/libs/xc/xenctrl.mli | 1 -
> tools/ocaml/libs/xc/xenctrl_stubs.c | 43 ++++++++++++++++++++++---------------
> 3 files changed, 27 insertions(+), 20 deletions(-)
>
> diff --git a/tools/ocaml/libs/xc/xenctrl.ml b/tools/ocaml/libs/xc/xenctrl.ml
> index aa650533f718..4b74e31c75cb 100644
> --- a/tools/ocaml/libs/xc/xenctrl.ml
> +++ b/tools/ocaml/libs/xc/xenctrl.ml
> @@ -175,7 +175,6 @@ exception Error of string
> type handle
>
> external interface_open: unit -> handle = "stub_xc_interface_open"
> -external interface_close: handle -> unit = "stub_xc_interface_close"
>
> let handle = ref None
>
> @@ -183,7 +182,7 @@ let get_handle () = !handle
>
> let close_handle () =
> match !handle with
> - | Some h -> handle := None; interface_close h
> + | Some h -> handle := None
> | None -> ()
>
> let with_intf f =
> diff --git a/tools/ocaml/libs/xc/xenctrl.mli b/tools/ocaml/libs/xc/xenctrl.mli
> index 5bf5f5dfea36..ddfe84dc22a9 100644
> --- a/tools/ocaml/libs/xc/xenctrl.mli
> +++ b/tools/ocaml/libs/xc/xenctrl.mli
> @@ -146,7 +146,6 @@ type shutdown_reason = Poweroff | Reboot | Suspend |
> Crash | Watchdog | Soft_res
> exception Error of string
> type handle
> external interface_open : unit -> handle = "stub_xc_interface_open"
> -external interface_close : handle -> unit = "stub_xc_interface_close"
>
> (** [with_intf f] runs [f] with a global handle that is opened on demand
> * and kept open. Conceptually, a client should use either
> diff --git a/tools/ocaml/libs/xc/xenctrl_stubs.c
> b/tools/ocaml/libs/xc/xenctrl_stubs.c
> index f37848ae0bb3..4e1204085422 100644
> --- a/tools/ocaml/libs/xc/xenctrl_stubs.c
> +++ b/tools/ocaml/libs/xc/xenctrl_stubs.c
> @@ -37,13 +37,28 @@
>
> #include "mmap_stubs.h"
>
> -#define _H(__h) ((xc_interface *)(__h))
> +#define _H(__h) (*((xc_interface **)Data_custom_val(__h)))
> #define _D(__d) ((uint32_t)Int_val(__d))
I think this requires an update in xenopsd too to match, otherwise it'll crash:
https://github.com/xapi-project/xenopsd/blob/master/c_stubs/xenctrlext_stubs.c#L32
This wasn't an issue with the original patch which used Data_abstract_val here,
because
that (currently) happens to boil down to just a cast (with some GC metadata
*before* it),
so the old way of just casting OCaml value to C pointer still worked.
However Data_custom_val boils down to accessing a value at +sizeof(value)
offset,
so xenopsd would now read the wrong pointer.
Perhaps it would've been better to have this _H defined in some header,
otherwise extending Xenctrl the way xenopsd does it is quite brittle.
Best regards,
--Edwin
>
> #ifndef Val_none
> #define Val_none (Val_int(0))
> #endif
>
> +static void stub_xenctrl_finalize(value v)
> +{
> + xc_interface_close(_H(v));
> +}
> +
> +static struct custom_operations xenctrl_ops = {
> + .identifier = "xenctrl",
> + .finalize = stub_xenctrl_finalize,
> + .compare = custom_compare_default, /* Can't compare */
> + .hash = custom_hash_default, /* Can't hash */
> + .serialize = custom_serialize_default, /* Can't serialize */
> + .deserialize = custom_deserialize_default, /* Can't deserialize */
> + .compare_ext = custom_compare_ext_default, /* Can't compare */
> +};
> +
> #define string_of_option_array(array, index) \
> ((Field(array, index) == Val_none) ? NULL : String_val(Field(Field(array,
> index), 0)))
>
> @@ -70,26 +85,20 @@ static void Noreturn failwith_xc(xc_interface *xch)
> CAMLprim value stub_xc_interface_open(void)
> {
> CAMLparam0();
> - xc_interface *xch;
> -
> - /* Don't assert XC_OPENFLAG_NON_REENTRANT because these bindings
> - * do not prevent re-entrancy to libxc */
> - xch = xc_interface_open(NULL, NULL, 0);
> - if (xch == NULL)
> - failwith_xc(NULL);
> - CAMLreturn((value)xch);
> -}
> -
> -
> -CAMLprim value stub_xc_interface_close(value xch)
> -{
> - CAMLparam1(xch);
> + CAMLlocal1(result);
> + xc_interface *xch;
>
> caml_enter_blocking_section();
> - xc_interface_close(_H(xch));
> + xch = xc_interface_open(NULL, NULL, 0);
> caml_leave_blocking_section();
>
> - CAMLreturn(Val_unit);
> + if ( !xch )
> + failwith_xc(xch);
> +
> + result = caml_alloc_custom(&xenctrl_ops, sizeof(xch), 0, 1);
> + _H(result) = xch;
> +
> + CAMLreturn(result);
> }
>
> static void domain_handle_of_uuid_string(xen_domain_handle_t h,
> --
> 2.11.0
>
