[Libguestfs] [libnbd PATCH] ocaml: map C's uint32_t to OCaml's int64

OCaml's fixed-width integers only come in signed flavor (int32, int64). Because of this, we currently map C's uint32_t and uint64_t types to OCaml's int32 and int64 types, respectively. Unfortunately, this can be considered a security bug: when the most significant bit of a C-language uint32_t or uint64_t value is set, it is reinterpreted (in two's complement representation) as a negative value in OCaml. This can cause various issues; it can for example make OCaml loops that should be strictly progressing go backwards (and run infinitely). Try to mitigate this issue at least for uint32_t: widen it to OCaml's int64 type. In the inverse direction (i.e., narrowing int64 to uint32_t), raise an OCaml Invalid_argument exception upon a range error. Bugzilla: https://bugzilla.redhat.com/show_bug.cgi?id=2040610 Signed-off-by: Laszlo Ersek <lersek(a)redhat.com&gt; --- Notes: This patch makes the following difference for the generated bindings: ocaml/nbd-c.h | 3 ++- generator/OCaml.ml | 11 ++++++++--- ocaml/examples/extents.ml | 12 ++++++------ ocaml/tests/test_460_block_status.ml | 16 ++++++++-------- ocaml/helpers.c | 4 ++-- 5 files changed, 26 insertions(+), 20 deletions(-) diff --git a/ocaml/nbd-c.h b/ocaml/nbd-c.h index d66c4d0a6a0d..0bf044ca9119 100644 --- a/ocaml/nbd-c.h +++ b/ocaml/nbd-c.h @@ -60,7 +60,8 @@ extern void nbd_internal_ocaml_raise_error (void) Noreturn; extern void nbd_internal_ocaml_raise_closed (const char *func) Noreturn; extern const char **nbd_internal_ocaml_string_list (value); -extern value nbd_internal_ocaml_alloc_int32_array (uint32_t *, size_t); +extern value nbd_internal_ocaml_alloc_int64_from_uint32_array (uint32_t *, + size_t); extern void nbd_internal_ocaml_exception_in_wrapper (const char *, value); /* Extract an NBD handle from an OCaml heap value. */ diff --git a/generator/OCaml.ml b/generator/OCaml.ml index 4e901648a6c0..c708d45438c0 100644 --- a/generator/OCaml.ml +++ b/generator/OCaml.ml @@ -54,7 +54,8 @@ and ocaml_arg_to_string = function | String _ -> "string" | StringList _ -> "string list" | UInt _ | UIntPtr _ -> "int" - | UInt32 _ -> "int32" + | UInt32 _ -> "int64 (* uint32_t *)" (* widening due to lack of uint32_t in + OCaml *) | UInt64 _ -> "int64" and ocaml_ret_to_string = function @@ -510,7 +511,7 @@ let print_ocaml_closure_wrapper { cbname; cbargs } = List.iter ( function | CBArrayAndLen (UInt32 n, count) -> - pr " %sv = nbd_internal_ocaml_alloc_int32_array (%s, %s);\n" + pr " %sv = nbd_internal_ocaml_alloc_int64_from_uint32_array (%s, %s);\n" n n count; | CBBytesIn (n, len) -> pr " %sv = caml_alloc_initialized_string (%s, %s);\n" n len n @@ -696,7 +697,10 @@ let print_ocaml_binding (name, { args; optargs; ret }) = | UInt n | UIntPtr n -> pr " unsigned %s = Int_val (%sv);\n" n n | UInt32 n -> - pr " uint32_t %s = Int32_val (%sv);\n" n n + pr " int64_t %s64 = Int64_val (%sv);\n" n n; + pr " if (%s64 < 0 || (uint64_t)%s64 > UINT32_MAX)\n" n n; + pr " caml_invalid_argument (\"'%s' out of range\");\n" n; + pr " uint32_t %s = (uint32_t)%s64;\n" n n; | UInt64 n -> pr " uint64_t %s = Int64_val (%sv);\n" n n ) args; @@ -793,6 +797,7 @@ let generate_ocaml_nbd_c () = pr "#include <config.h>\n"; pr "\n"; + pr "#include <stdint.h>\n"; pr "#include <stdio.h>\n"; pr "#include <stdlib.h>\n"; pr "#include <string.h>\n"; diff --git a/ocaml/examples/extents.ml b/ocaml/examples/extents.ml index 44ecd8db22d8..4ebd6467f239 100644 --- a/ocaml/examples/extents.ml +++ b/ocaml/examples/extents.ml @@ -20,14 +20,14 @@ let () = if meta = "base:allocation" then ( printf "index\t%16s %16s %s\n" "offset" "length" "flags"; for i = 0 to Array.length entries / 2 - 1 do - let len = Int64.of_int32 entries.(i*2) + let len = entries.(i*2) and flags = match entries.(i*2+1) with - | 0_l -> "data" - | 1_l -> "hole" - | 2_l -> "zero" - | 3_l -> "hole+zero" - | i -> sprintf "unknown (%ld)" i in + | 0_L -> "data" + | 1_L -> "hole" + | 2_L -> "zero" + | 3_L -> "hole+zero" + | unknown -> sprintf "unknown (%Ld)" unknown in printf "%d:\t%16Ld %16Ld %s\n" i !fetch_offset len flags; fetch_offset := Int64.add !fetch_offset len done; diff --git a/ocaml/tests/test_460_block_status.ml b/ocaml/tests/test_460_block_status.ml index 8f442e1f8793..3caf3d5ee687 100644 --- a/ocaml/tests/test_460_block_status.ml +++ b/ocaml/tests/test_460_block_status.ml @@ -41,18 +41,18 @@ let () = "sh"; script]; NBD.block_status nbd 65536_L 0_L (f 42); - assert (!entries = [| 8192_l; 0_l; - 8192_l; 1_l; - 16384_l; 3_l; - 16384_l; 2_l; - 16384_l; 0_l |]); + assert (!entries = [| 8192_L; 0_L; + 8192_L; 1_L; + 16384_L; 3_L; + 16384_L; 2_L; + 16384_L; 0_L |]); NBD.block_status nbd 1024_L 32256_L (f 42); - assert (!entries = [| 512_l; 3_l; - 16384_l; 2_l |]); + assert (!entries = [| 512_L; 3_L; + 16384_L; 2_L |]); let flags = let open NBD.CMD_FLAG in [REQ_ONE] in NBD.block_status nbd 1024_L 32256_L (f 42) ~flags; - assert (!entries = [| 512_l; 3_l |]) + assert (!entries = [| 512_L; 3_L |]) let () = Gc.compact () diff --git a/ocaml/helpers.c b/ocaml/helpers.c index 90333cd72afd..1f934bb10beb 100644 --- a/ocaml/helpers.c +++ b/ocaml/helpers.c @@ -97,7 +97,7 @@ nbd_internal_ocaml_string_list (value ssv) } value -nbd_internal_ocaml_alloc_int32_array (uint32_t *a, size_t len) +nbd_internal_ocaml_alloc_int64_from_uint32_array (uint32_t *a, size_t len) { CAMLparam0 (); CAMLlocal2 (v, rv); @@ -105,7 +105,7 @@ nbd_internal_ocaml_alloc_int32_array (uint32_t *a, size_t len) rv = caml_alloc (len, 0); for (i = 0; i < len; ++i) { - v = caml_copy_int32 (a[i]); + v = caml_copy_int64 (a[i]); Store_field (rv, i, v); } base-commit: c920d8a5b0d6519ce9c7bbc95322ead1a22b45a2 -- 2.19.1.3.g30247aa5d201