Laszlo Ersek
2022-Jan-14 13:38 UTC
[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 at redhat.com>
---
Notes:
This patch makes the following difference for the generated bindings:
> diff -u -r -p backup/ocaml/NBD.ml new/ocaml/NBD.ml
> --- backup/ocaml/NBD.ml 2021-12-16 11:04:49.000000000 +0100
> +++ new/ocaml/NBD.ml 2022-01-14 11:28:09.000000000 +0100
> @@ -237,7 +237,7 @@ external connect_uri : t -> string -> un
> = "nbd_internal_ocaml_nbd_connect_uri"
> external connect_unix : t -> string -> unit
> = "nbd_internal_ocaml_nbd_connect_unix"
> -external connect_vsock : t -> int32 -> int32 -> unit
> +external connect_vsock : t -> int64 (* uint32_t *) -> int64 (*
uint32_t *) -> unit
> = "nbd_internal_ocaml_nbd_connect_vsock"
> external connect_tcp : t -> string -> string -> unit
> = "nbd_internal_ocaml_nbd_connect_tcp"
> @@ -291,7 +291,7 @@ external cache : ?flags:CMD_FLAG.t list
> = "nbd_internal_ocaml_nbd_cache"
> external zero : ?flags:CMD_FLAG.t list -> t -> int64 -> int64
-> unit
> = "nbd_internal_ocaml_nbd_zero"
> -external block_status : ?flags:CMD_FLAG.t list -> t -> int64
-> int64 -> (string -> int64 -> int32 array -> int ref -> int)
-> unit
> +external block_status : ?flags:CMD_FLAG.t list -> t -> int64
-> int64 -> (string -> int64 -> int64 (* uint32_t *) array -> int
ref -> int) -> unit
> = "nbd_internal_ocaml_nbd_block_status"
> external poll : t -> int -> int
> = "nbd_internal_ocaml_nbd_poll"
> @@ -301,7 +301,7 @@ external aio_connect_uri : t -> string -
> = "nbd_internal_ocaml_nbd_aio_connect_uri"
> external aio_connect_unix : t -> string -> unit
> = "nbd_internal_ocaml_nbd_aio_connect_unix"
> -external aio_connect_vsock : t -> int32 -> int32 -> unit
> +external aio_connect_vsock : t -> int64 (* uint32_t *) -> int64
(* uint32_t *) -> unit
> = "nbd_internal_ocaml_nbd_aio_connect_vsock"
> external aio_connect_tcp : t -> string -> string -> unit
> = "nbd_internal_ocaml_nbd_aio_connect_tcp"
> @@ -337,7 +337,7 @@ external aio_cache : ?completion:(int re
> = "nbd_internal_ocaml_nbd_aio_cache"
> external aio_zero : ?completion:(int ref -> int) ->
?flags:CMD_FLAG.t list -> t -> int64 -> int64 -> cookie
> = "nbd_internal_ocaml_nbd_aio_zero"
> -external aio_block_status : ?completion:(int ref -> int) ->
?flags:CMD_FLAG.t list -> t -> int64 -> int64 -> (string -> int64
-> int32 array -> int ref -> int) -> cookie
> +external aio_block_status : ?completion:(int ref -> int) ->
?flags:CMD_FLAG.t list -> t -> int64 -> int64 -> (string -> int64
-> int64 (* uint32_t *) array -> int ref -> int) -> cookie
> = "nbd_internal_ocaml_nbd_aio_block_status_byte"
"nbd_internal_ocaml_nbd_aio_block_status"
> external aio_get_fd : t -> Unix.file_descr
> = "nbd_internal_ocaml_nbd_aio_get_fd"
> diff -u -r -p backup/ocaml/NBD.mli new/ocaml/NBD.mli
> --- backup/ocaml/NBD.mli 2021-12-16 11:04:49.000000000 +0100
> +++ new/ocaml/NBD.mli 2022-01-14 11:28:09.000000000 +0100
> @@ -1105,7 +1105,7 @@ val connect_unix : t -> string -> unit
> been made.
> *)
>
> -val connect_vsock : t -> int32 -> int32 -> unit
> +val connect_vsock : t -> int64 (* uint32_t *) -> int64 (*
uint32_t *) -> unit
> (** connect to NBD server over AF_VSOCK protocol
>
> Connect (synchronously) over the "AF_VSOCK" protocol
> @@ -1706,7 +1706,7 @@ val zero : ?flags:CMD_FLAG.t list -> t -
> than failing fast.
> *)
>
> -val block_status : ?flags:CMD_FLAG.t list -> t -> int64 ->
int64 -> (string -> int64 -> int32 array -> int ref -> int) ->
unit
> +val block_status : ?flags:CMD_FLAG.t list -> t -> int64 ->
int64 -> (string -> int64 -> int64 (* uint32_t *) array -> int ref
-> int) -> unit
> (** send block status command to the NBD server
>
> Issue the block status command to the NBD server. If
> @@ -1835,7 +1835,7 @@ val aio_connect_unix : t -> string -> un
> nbd_aio_is_ready(3), on the connection.
> *)
>
> -val aio_connect_vsock : t -> int32 -> int32 -> unit
> +val aio_connect_vsock : t -> int64 (* uint32_t *) -> int64 (*
uint32_t *) -> unit
> (** connect to the NBD server over AF_VSOCK socket
>
> Begin connecting to the NBD server over the "AF_VSOCK"
> @@ -2158,7 +2158,7 @@ val aio_zero : ?completion:(int ref -> i
> than failing fast.
> *)
>
> -val aio_block_status : ?completion:(int ref -> int) ->
?flags:CMD_FLAG.t list -> t -> int64 -> int64 -> (string -> int64
-> int32 array -> int ref -> int) -> cookie
> +val aio_block_status : ?completion:(int ref -> int) ->
?flags:CMD_FLAG.t list -> t -> int64 -> int64 -> (string -> int64
-> int64 (* uint32_t *) array -> int ref -> int) -> cookie
> (** send block status command to the NBD server
>
> Send the block status command to the NBD server.
> diff -u -r -p backup/ocaml/nbd-c.c new/ocaml/nbd-c.c
> --- backup/ocaml/nbd-c.c 2021-12-16 11:04:49.000000000 +0100
> +++ new/ocaml/nbd-c.c 2022-01-14 11:28:09.000000000 +0100
> @@ -22,6 +22,7 @@
>
> #include <config.h>
>
> +#include <stdint.h>
> #include <stdio.h>
> #include <stdlib.h>
> #include <string.h>
> @@ -204,7 +205,7 @@ extent_wrapper_locked (void *user_data,
>
> metacontextv = caml_copy_string (metacontext);
> offsetv = caml_copy_int64 (offset);
> - entriesv = nbd_internal_ocaml_alloc_int32_array (entries,
nr_entries);
> + entriesv = nbd_internal_ocaml_alloc_int64_from_uint32_array
(entries, nr_entries);
> errorv = caml_alloc_tuple (1);
> Store_field (errorv, 0, Val_int (*error));
> args[0] = metacontextv;
> @@ -1745,8 +1746,14 @@ nbd_internal_ocaml_nbd_connect_vsock (va
> if (h == NULL)
> nbd_internal_ocaml_raise_closed ("NBD.connect_vsock");
>
> - uint32_t cid = Int32_val (cidv);
> - uint32_t port = Int32_val (portv);
> + int64_t cid64 = Int64_val (cidv);
> + if (cid64 < 0 || (uint64_t)cid64 > UINT32_MAX)
> + caml_invalid_argument ("'cid' out of range");
> + uint32_t cid = (uint32_t)cid64;
> + int64_t port64 = Int64_val (portv);
> + if (port64 < 0 || (uint64_t)port64 > UINT32_MAX)
> + caml_invalid_argument ("'port' out of range");
> + uint32_t port = (uint32_t)port64;
> int r;
>
> caml_enter_blocking_section ();
> @@ -2589,8 +2596,14 @@ nbd_internal_ocaml_nbd_aio_connect_vsock
> if (h == NULL)
> nbd_internal_ocaml_raise_closed
("NBD.aio_connect_vsock");
>
> - uint32_t cid = Int32_val (cidv);
> - uint32_t port = Int32_val (portv);
> + int64_t cid64 = Int64_val (cidv);
> + if (cid64 < 0 || (uint64_t)cid64 > UINT32_MAX)
> + caml_invalid_argument ("'cid' out of range");
> + uint32_t cid = (uint32_t)cid64;
> + int64_t port64 = Int64_val (portv);
> + if (port64 < 0 || (uint64_t)port64 > UINT32_MAX)
> + caml_invalid_argument ("'port' out of range");
> + uint32_t port = (uint32_t)port64;
> int r;
>
> caml_enter_blocking_section ();
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
Richard W.M. Jones
2022-Jan-14 14:03 UTC
[Libguestfs] [libnbd PATCH] ocaml: map C's uint32_t to OCaml's int64
On Fri, Jan 14, 2022 at 02:38:33PM +0100, Laszlo Ersek wrote:> --- 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)It actually improves the code, I wasn't expecting that :-) This all looks great to me, ACK. Reviewed-by: Richard W.M. Jones <rjones at redhat.com> I think you should be able to push it directly since you are already a member of the libnbd project. Rich. -- Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones Read my programming and virtualization blog: http://rwmj.wordpress.com virt-top is 'top' for virtual machines. Tiny program with many powerful monitoring features, net stats, disk stats, logging, etc. http://people.redhat.com/~rjones/virt-top