[Libguestfs] [PATCH v6 30/41] daemon: Enable RStruct, RStructList for OCaml-implemented APIs.

Richard W.M. Jones
Thu, 15 Jun 2017 17:06:20 -0000

---
 .gitignore          |   1 +
 daemon/Makefile.am  |   1 +
 generator/OCaml.ml  |   8 ++++
 generator/OCaml.mli |   1 +
 generator/daemon.ml | 116 +++++++++++++++++++++++++++++++++++++++++++++++++++-
 generator/main.ml   |   2 +
 6 files changed, 127 insertions(+), 2 deletions(-)

diff --git a/.gitignore b/.gitignore
index 6fceba555..bca927afc 100644
--- a/.gitignore
+++ b/.gitignore
@@ -183,6 +183,7 @@ Makefile.in
 /daemon/stamp-guestfsd.pod
 /daemon/structs-cleanups.c
 /daemon/structs-cleanups.h
+/daemon/structs.ml
 /daemon/stubs-?.c
 /daemon/stubs.h
 /daemon/types.ml
diff --git a/daemon/Makefile.am b/daemon/Makefile.am
index 0c5389557..02afabcab 100644
--- a/daemon/Makefile.am
+++ b/daemon/Makefile.am
@@ -278,6 +278,7 @@ SOURCES_MLI = \
 SOURCES_ML = \
 	types.ml \
 	utils.ml \
+	structs.ml \
 	sysroot.ml \
 	mountable.ml \
 	chroot.ml \
diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index d3929475a..d05bb495b 100644
--- a/generator/OCaml.ml
+++ b/generator/OCaml.ml
@@ -888,3 +888,11 @@ and generate_ocaml_function_type ?(extra_unit = false)
(ret, args, optargs)     | RStructList (_, typ) -> pr "%s array"
typ
    | RHashtable _ -> pr "(string * string) list"
   )
+
+(* Structure definitions (again).  These are used in the daemon,
+ * but it's convenient to generate them here.
+ *)
+and generate_ocaml_daemon_structs () +  generate_header OCamlStyle GPLv2plus;
+
+  generate_ocaml_structure_decls ()
diff --git a/generator/OCaml.mli b/generator/OCaml.mli
index 4e79a5b5a..a36fbe02f 100644
--- a/generator/OCaml.mli
+++ b/generator/OCaml.mli
@@ -20,3 +20,4 @@ val generate_ocaml_c : unit -> unit
 val generate_ocaml_c_errnos : unit -> unit
 val generate_ocaml_ml : unit -> unit
 val generate_ocaml_mli : unit -> unit
+val generate_ocaml_daemon_structs : unit -> unit
diff --git a/generator/daemon.ml b/generator/daemon.ml
index 1d7461f8c..8cac5ccb1 100644
--- a/generator/daemon.ml
+++ b/generator/daemon.ml
@@ -575,6 +575,110 @@ return_string_list (value retv)

 ";

+  (* Implement code for returning structs and struct lists. *)
+  let emit_return_struct typ +    let struc = Structs.lookup_struct typ in
+    pr "/* Implement RStruct (%S, _). */\n" typ;
+    pr "static guestfs_int_%s *\n" typ;
+    pr "return_%s (value retv)\n" typ;
+    pr "{\n";
+    pr "  guestfs_int_%s *ret;\n" typ;
+    pr "  value v;\n";
+    pr "\n";
+    pr "  ret = malloc (sizeof (*ret));\n";
+    pr "  if (ret == NULL) {\n";
+    pr "    reply_with_perror (\"malloc\");\n";
+    pr "    return NULL;\n";
+    pr "  }\n";
+    pr "\n";
+    iteri (
+      fun i ->
+        pr "  v = Field (retv, %d);\n" i;
+        function
+        | n, (FString|FUUID) ->
+           pr "  ret->%s = strdup (String_val (v));\n" n;
+           pr "  if (ret->%s == NULL) return NULL;\n" n
+        | n, FBuffer ->
+           pr "  ret->%s_len = caml_string_length (v);\n" n;
+           pr "  ret->%s = strdup (String_val (v));\n" n;
+           pr "  if (ret->%s == NULL) return NULL;\n" n
+        | n, (FBytes|FInt64|FUInt64) ->
+           pr "  ret->%s = Int64_val (v);\n" n
+        | n, (FInt32|FUInt32) ->
+           pr "  ret->%s = Int32_val (v);\n" n
+        | n, FOptPercent ->
+           pr "  if (v == Val_int (0)) /* None */\n";
+           pr "    ret->%s = -1;\n" n;
+           pr "  else {\n";
+           pr "    v = Field (v, 0);\n";
+           pr "    ret->%s = Double_val (v);\n" n;
+           pr "  }\n"
+        | n, FChar ->
+           pr "  ret->%s = Int_val (v);\n" n
+    ) struc.s_cols;
+    pr "\n";
+    pr "  return ret;\n";
+    pr "}\n";
+    pr "\n"
+
+  and emit_return_struct_list typ +    pr "/* Implement RStructList (%S,
_). */\n" typ;
+    pr "static guestfs_int_%s_list *\n" typ;
+    pr "return_%s_list (value retv)\n" typ;
+    pr "{\n";
+    pr "  guestfs_int_%s_list *ret;\n" typ;
+    pr "  guestfs_int_%s *r;\n" typ;
+    pr "  size_t i, len;\n";
+    pr "  value v, rv;\n";
+    pr "\n";
+    pr "  /* Count the number of elements in the list. */\n";
+    pr "  rv = retv;\n";
+    pr "  len = 0;\n";
+    pr "  while (rv != Val_int (0)) {\n";
+    pr "    len++;\n";
+    pr "    rv = Field (rv, 1);\n";
+    pr "  }\n";
+    pr "\n";
+    pr "  ret = malloc (sizeof *ret);\n";
+    pr "  if (ret == NULL) {\n";
+    pr "    reply_with_perror (\"malloc\");\n";
+    pr "    return NULL;\n";
+    pr "  }\n";
+    pr "  ret->guestfs_int_%s_list_len = len;\n" typ;
+    pr "  ret->guestfs_int_%s_list_val =\n" typ;
+    pr "    calloc (len, sizeof (guestfs_int_%s));\n" typ;
+    pr "  if (ret->guestfs_int_%s_list_val == NULL) {\n" typ;
+    pr "    reply_with_perror (\"calloc\");\n";
+    pr "    free (ret);\n";
+    pr "    return NULL;\n";
+    pr "  }\n";
+    pr "\n";
+    pr "  rv = retv;\n";
+    pr "  for (i = 0; i < len; ++i) {\n";
+    pr "    v = Field (rv, 0);\n";
+    pr "    r = return_%s (v);\n" typ;
+    pr "    if (r == NULL)\n";
+    pr "      return NULL; /* XXX leaks memory along this error path
*/\n";
+    pr "    memcpy (&ret->guestfs_int_%s_list_val[i], r, sizeof
(*r));\n" typ;
+    pr "    free (r);\n";
+    pr "    rv = Field (rv, 1);\n";
+    pr "  }\n";
+    pr "\n";
+    pr "  return ret;\n";
+    pr "}\n";
+    pr "\n";
+  in
+
+  List.iter (
+    function
+    | typ, RStructOnly ->
+       emit_return_struct typ
+    | typ, (RStructListOnly | RStructAndList) ->
+       emit_return_struct typ;
+       emit_return_struct_list typ
+  ) (rstructs_used_by (actions |> impl_ocaml_functions));
+
+  (* Implement the wrapper functions. *)
   List.iter (
     fun ({ name = name; style = ret, args, optargs } as f) ->
       let uc_name = String.uppercase_ascii name in
@@ -709,8 +813,16 @@ return_string_list (value retv)
        | RStringList _ ->
           pr "  char **ret = return_string_list (retv);\n";
           pr "  CAMLreturnT (char **, ret); /* caller frees */\n"
-       | RStruct _ -> assert false
-       | RStructList _ -> assert false
+       | RStruct (_, typ) ->
+          pr "  guestfs_int_%s *ret =\n" typ;
+          pr "    return_%s (retv);\n" typ;
+          pr "  /* caller frees */\n";
+          pr "  CAMLreturnT (guestfs_int_%s *, ret);\n" typ
+       | RStructList (_, typ) ->
+          pr "  guestfs_int_%s_list *ret =\n" typ;
+          pr "    return_%s_list (retv);\n" typ;
+          pr "  /* caller frees */\n";
+          pr "  CAMLreturnT (guestfs_int_%s_list *, ret);\n" typ
        | RHashtable _ -> assert false
        | RBufferOut _ -> assert false
       );
diff --git a/generator/main.ml b/generator/main.ml
index a6c805e2e..72f704b8e 100644
--- a/generator/main.ml
+++ b/generator/main.ml
@@ -191,6 +191,8 @@ Run it from the top source directory using the command
             OCaml.generate_ocaml_c;
   output_to "ocaml/guestfs-c-errnos.c"
             OCaml.generate_ocaml_c_errnos;
+  output_to "daemon/structs.ml"
+            OCaml.generate_ocaml_daemon_structs;
   output_to "ocaml/bindtests.ml"
             Bindtests.generate_ocaml_bindtests;

--
2.13.0