[Libguestfs] [libnbd PATCH v4 07/25] generator: Support Extent64 arg in OCaml code

[Eric Blake]

See the earlier commit "Add Extent64 arg type" for rationale in
supporting a new generator arg type.  This patch adds the OCaml
bindings for use of Extent64, which required adding a counterpart
OCaml type.

Note that we intend to guarantee that the size is always a positive
value.  If we were using using structured_reply_in_bounds() like we do
for REPLY_TYPE_DATA, this would be trivial; but in practice, the NBD
protocol says we have to accept server responses that extend beyond
the bounds of the client's request.  Still, the state machine can
easily check that the server's cumulative size has not exceeded the
export's length, which in practice is limited by off_t; furthermore,
the NBD protocol allows truncation of the response as long as the
client makes progress, and the client does not have to know whether
that truncation happened at the server or in our state machine.
Therefore, our assertion of a positive size viable.

However, the flags can be negative: OCaml's only native 64-bit integer
is inherently signed, but at least it does have a logical shift
operator for performing unsigned bit-twiddling operations.

Signed-off-by: Eric Blake <eblake at redhat.com>
---

v4: split out of larger patch [Laszlo], avoid awkward slice since we
can't use copy() anyway [Laszlo]
---
 generator/OCaml.ml | 18 +++++++++++++++---
 ocaml/helpers.c    | 21 +++++++++++++++++++++
 ocaml/nbd-c.h      |  1 +
 3 files changed, 37 insertions(+), 3 deletions(-)

diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index 7971ac40..621a4348 100644
--- a/generator/OCaml.ml
+++ b/generator/OCaml.ml
@@ -44,7 +44,7 @@ and
   | Closure { cbargs } ->
      sprintf "(%s)" (ocaml_closuredecl_to_string cbargs)
   | Enum (_, { enum_prefix }) -> sprintf "%s.t" enum_prefix
-  | Extent64 _ -> assert false (* only used in extent64_closure *)
+  | Extent64 _ -> "extent"
   | Fd _ -> "Unix.file_descr"
   | Flags (_, { flag_prefix }) -> sprintf "%s.t list" flag_prefix
   | Int _ -> "int"
@@ -149,6 +149,9 @@ let

 type cookie = int64

+type extent = int64 * int64
+(** Length and flags of an extent in block_status_64 callback. *)
+
 ";

   List.iter (
@@ -270,6 +273,7 @@ let
 exception Error of string * Unix.error option
 exception Closed of string
 type cookie = int64
+type extent = int64 * int64

 (* Give the exceptions names so that they can be raised from the C code. *)
 let () =
@@ -500,7 +504,7 @@ let
   let argnames =
     List.map (
       function
-      | CBArrayAndLen (UInt32 n, _) | CBBytesIn (n, _)
+      | CBArrayAndLen ((UInt32 n | Extent64 n), _) | CBBytesIn (n, _)
       | CBInt n | CBInt64 n
       | CBMutable (Int n) | CBString n | CBUInt n | CBUInt64 n ->
          n ^ "v"
@@ -533,6 +537,14 @@ let
        pr "%s  %s,\n" indent n;
        pr "%s  %s\n" indent count;
        pr "%s);\n" indent
+    | CBArrayAndLen (Extent64 n, count) ->
+       pr "  %sv = " n;
+       let fncol = output_column () in
+       let indent = spaces fncol in
+       pr "nbd_internal_ocaml_alloc_extent64_array (\n";
+       pr "%s  %s,\n" indent n;
+       pr "%s  %s\n" indent count;
+       pr "%s);\n" indent
     | CBBytesIn (n, len) ->
        pr "  %sv = caml_alloc_initialized_string (%s, %s);\n" n len n
     | CBInt n | CBUInt n ->
@@ -556,7 +568,7 @@ let

   List.iter (
     function
-    | CBArrayAndLen (UInt32 _, _)
+    | CBArrayAndLen ((UInt32 _ | Extent64 _), _)
     | CBBytesIn _
     | CBInt _
     | CBInt64 _
diff --git a/ocaml/helpers.c b/ocaml/helpers.c
index 3361a696..7f40534a 100644
--- a/ocaml/helpers.c
+++ b/ocaml/helpers.c
@@ -133,6 +133,27 @@ nbd_internal_ocaml_alloc_i64_from_u32_array (uint32_t *a, size_t len)
   CAMLreturn (rv);
 }

+value
+nbd_internal_ocaml_alloc_extent64_array (nbd_extent *a, size_t len)
+{
+  CAMLparam0 ();
+  CAMLlocal3 (s, v, rv);
+  size_t i;
+
+  rv = caml_alloc (len, 0);
+  for (i = 0; i < len; ++i) {
+    s = caml_alloc (2, 0);
+    assert (a[i].length <= INT64_MAX);  /* API ensures size fits in 63 bits */
+    v = caml_copy_int64 (a[i].length);
+    Store_field (s, 0, v);
+    v = caml_copy_int64 (a[i].flags);
+    Store_field (s, 1, v);
+    Store_field (rv, i, s);
+  }
+
+  CAMLreturn (rv);
+}
+
 /* Convert a Unix.sockaddr to a C struct sockaddr. */
 void
 nbd_internal_unix_sockaddr_to_sa (value sockaddrv,
diff --git a/ocaml/nbd-c.h b/ocaml/nbd-c.h
index e3abb912..adcdd15a 100644
--- a/ocaml/nbd-c.h
+++ b/ocaml/nbd-c.h
@@ -62,6 +62,7 @@ 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_i64_from_u32_array (uint32_t *, size_t);
+extern value nbd_internal_ocaml_alloc_extent64_array (nbd_extent *, size_t);
 extern void nbd_internal_unix_sockaddr_to_sa (value, struct sockaddr_storage *,
                                               socklen_t *);
 extern void nbd_internal_ocaml_exception_in_wrapper (const char *, value);
-- 
2.41.0