[Libguestfs] [PATCH nbdkit v2 1/2] ocaml: Change pread method to avoid leaking heap memory.

[Richard W.M. Jones]

In the C part of the OCaml plugin we created a ‘bytes’ [byte array]
and passed it to the OCaml pread method.  The plugin is supposed to
overwrite the array with the returned data.

However if (eg. because of a bug) the plugin does not fill the array
then whatever was in the OCaml or possibly even the C heap before the
allocation is returned to the client, possibly resulting in a leak of
sensitive data.

This changes the signature of the pread function in OCaml plugins.
Instead of passing in an uninitialized ‘bytes’ object of the right
length, the count is passed explicitly and the pread method should
return a string of the correct length.  This is both more similar to
how other language plugins work, and is safer because all allocation
is done on the OCaml side.

  - pread : 'a -> bytes -> int64 -> flags -> unit
  + pread : 'a -> int32 -> int64 -> flags -> string

Credit: Eric Blake for finding the bug.
---
 plugins/ocaml/ocaml.c      | 16 ++++++++++++----
 plugins/ocaml/NBDKit.ml    |  4 ++--
 plugins/ocaml/NBDKit.mli   |  2 +-
 tests/test_ocaml_plugin.ml |  8 +++++---
 4 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/plugins/ocaml/ocaml.c b/plugins/ocaml/ocaml.c
index d854f48..39704e2 100644
--- a/plugins/ocaml/ocaml.c
+++ b/plugins/ocaml/ocaml.c
@@ -439,15 +439,16 @@ pread_wrapper (void *h, void *buf, uint32_t count, uint64_t offset,
                uint32_t flags)
 {
   CAMLparam0 ();
-  CAMLlocal4 (rv, strv, offsetv, flagsv);
+  CAMLlocal4 (rv, countv, offsetv, flagsv);
+  mlsize_t len;
 
   caml_leave_blocking_section ();
 
-  strv = caml_alloc_string (count);
+  countv = caml_copy_int32 (count);
   offsetv = caml_copy_int64 (offset);
   flagsv = Val_flags (flags);
 
-  value args[] = { *(value *) h, strv, offsetv, flagsv };
+  value args[] = { *(value *) h, countv, offsetv, flagsv };
   rv = caml_callbackN_exn (pread_fn, sizeof args / sizeof args[0], args);
   if (Is_exception_result (rv)) {
     nbdkit_error ("%s", caml_format_exception (Extract_exception (rv)));
@@ -455,7 +456,14 @@ pread_wrapper (void *h, void *buf, uint32_t count, uint64_t offset,
     CAMLreturnT (int, -1);
   }
 
-  memcpy (buf, String_val (strv), count);
+  len = caml_string_length (rv);
+  if (len < count) {
+    nbdkit_error ("buffer returned from pread is too small");
+    caml_enter_blocking_section ();
+    CAMLreturnT (int, -1);
+  }
+
+  memcpy (buf, String_val (rv), count);
 
   caml_enter_blocking_section ();
   CAMLreturnT (int, 0);
diff --git a/plugins/ocaml/NBDKit.ml b/plugins/ocaml/NBDKit.ml
index b03ff5a..14b9803 100644
--- a/plugins/ocaml/NBDKit.ml
+++ b/plugins/ocaml/NBDKit.ml
@@ -65,7 +65,7 @@ type 'a plugin = {
   can_zero : ('a -> bool) option;
   can_fua : ('a -> fua_flag) option;
 
-  pread : ('a -> bytes -> int64 -> flags -> unit) option;
+  pread : ('a -> int32 -> int64 -> flags -> string) option;
   pwrite : ('a -> string -> int64 -> flags -> unit) option;
   flush : ('a -> flags -> unit) option;
   trim : ('a -> int32 -> int64 -> flags -> unit) option;
@@ -146,7 +146,7 @@ external set_dump_plugin : (unit -> unit) -> unit = "ocaml_nbdkit_set_dump_plugi
 external set_can_zero : ('a -> bool) -> unit = "ocaml_nbdkit_set_can_zero"
 external set_can_fua : ('a -> fua_flag) -> unit = "ocaml_nbdkit_set_can_fua"
 
-external set_pread : ('a -> bytes -> int64 -> flags -> unit) -> unit = "ocaml_nbdkit_set_pread"
+external set_pread : ('a -> int32 -> int64 -> flags -> string) -> unit = "ocaml_nbdkit_set_pread"
 external set_pwrite : ('a -> string -> int64 -> flags -> unit) -> unit = "ocaml_nbdkit_set_pwrite"
 external set_flush : ('a -> flags -> unit) -> unit = "ocaml_nbdkit_set_flush"
 external set_trim : ('a -> int32 -> int64 -> flags -> unit) -> unit = "ocaml_nbdkit_set_trim"
diff --git a/plugins/ocaml/NBDKit.mli b/plugins/ocaml/NBDKit.mli
index d1e1343..7482118 100644
--- a/plugins/ocaml/NBDKit.mli
+++ b/plugins/ocaml/NBDKit.mli
@@ -67,7 +67,7 @@ type 'a plugin = {
   can_zero : ('a -> bool) option;
   can_fua : ('a -> fua_flag) option;
 
-  pread : ('a -> bytes -> int64 -> flags -> unit) option;  (* required *)
+  pread : ('a -> int32 -> int64 -> flags -> string) option;  (* required *)
   pwrite : ('a -> string -> int64 -> flags -> unit) option;
   flush : ('a -> flags -> unit) option;
   trim : ('a -> int32 -> int64 -> flags -> unit) option;
diff --git a/tests/test_ocaml_plugin.ml b/tests/test_ocaml_plugin.ml
index 842f10e..f27c099 100644
--- a/tests/test_ocaml_plugin.ml
+++ b/tests/test_ocaml_plugin.ml
@@ -28,9 +28,11 @@ let test_close h =
 let test_get_size h =
   Int64.of_int (Bytes.length h.disk)
 
-let test_pread h buf offset _ =
-  let len = Bytes.length buf in
-  Bytes.blit h.disk (Int64.to_int offset) buf 0 len
+let test_pread h count offset _ =
+  let count = Int32.to_int count in
+  let buf = Bytes.create count in
+  Bytes.blit h.disk (Int64.to_int offset) buf 0 count;
+  Bytes.unsafe_to_string buf
 
 let test_pwrite h buf offset _ =
   let len = String.length buf in
-- 
2.20.1