Re: [PATCH] tools/ocaml/xenctrl: OCaml 5 support, fix use-after-free

[Edwin Torok <edvin.torok@xxxxxxxxxx>]

> On 23 Nov 2022, at 22:25, Andrew Cooper <andrew.cooper3@xxxxxxxxxx> 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 <andrew.cooper3@xxxxxxxxxx>
> ---
> CC: Christian Lindig <christian.lindig@xxxxxxxxxx>
> CC: David Scott <dave@xxxxxxxxxx>
> CC: Edwin Torok <edvin.torok@xxxxxxxxxx>
> CC: Rob Hoes <Rob.Hoes@xxxxxxxxxx>
> 
> 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
>