Add Erlang bindings.

5 files changed, 461 insertions, 8 deletions

diff --git a/generator/.depend b/generator/.depend
index b2963f26..85f228d6 100644
--- a/generator/.depend
+++ b/generator/.depend
@@ -124,6 +124,14 @@ generator_php.cmo: generator_utils.cmi generator_types.cmo \
 generator_php.cmx: generator_utils.cmx generator_types.cmx \
     generator_structs.cmx generator_pr.cmx generator_optgroups.cmx \
     generator_docstrings.cmx generator_c.cmx generator_actions.cmx
+generator_erlang.cmo: generator_utils.cmi generator_types.cmo \
+    generator_structs.cmi generator_pr.cmi generator_optgroups.cmo \
+    generator_events.cmo generator_docstrings.cmo generator_c.cmo \
+    generator_actions.cmi
+generator_erlang.cmx: generator_utils.cmx generator_types.cmx \
+    generator_structs.cmx generator_pr.cmx generator_optgroups.cmx \
+    generator_events.cmx generator_docstrings.cmx generator_c.cmx \
+    generator_actions.cmx
 generator_bindtests.cmo: generator_utils.cmi generator_types.cmo \
     generator_structs.cmi generator_pr.cmi generator_optgroups.cmo \
     generator_docstrings.cmo generator_c.cmo generator_actions.cmi
@@ -138,13 +146,13 @@ generator_main.cmo: generator_xdr.cmo generator_structs.cmi \
     generator_ruby.cmo generator_python.cmo generator_pr.cmi \
     generator_php.cmo generator_perl.cmo generator_ocaml.cmo \
     generator_java.cmo generator_haskell.cmo generator_fish.cmo \
-    generator_errnostring.cmo generator_daemon.cmo generator_csharp.cmo \
-    generator_capitests.cmo generator_c.cmo generator_bindtests.cmo \
-    generator_api_versions.cmi
+    generator_errnostring.cmo generator_erlang.cmo generator_daemon.cmo \
+    generator_csharp.cmo generator_capitests.cmo generator_c.cmo \
+    generator_bindtests.cmo generator_api_versions.cmi
 generator_main.cmx: generator_xdr.cmx generator_structs.cmx \
     generator_ruby.cmx generator_python.cmx generator_pr.cmx \
     generator_php.cmx generator_perl.cmx generator_ocaml.cmx \
     generator_java.cmx generator_haskell.cmx generator_fish.cmx \
-    generator_errnostring.cmx generator_daemon.cmx generator_csharp.cmx \
-    generator_capitests.cmx generator_c.cmx generator_bindtests.cmx \
-    generator_api_versions.cmx
+    generator_errnostring.cmx generator_erlang.cmx generator_daemon.cmx \
+    generator_csharp.cmx generator_capitests.cmx generator_c.cmx \
+    generator_bindtests.cmx generator_api_versions.cmx
diff --git a/generator/Makefile.am b/generator/Makefile.am
index a127a87b..51a94624 100644
--- a/generator/Makefile.am
+++ b/generator/Makefile.am
@@ -1,5 +1,5 @@
 # libguestfs
-# Copyright (C) 2010 Red Hat Inc.
+# Copyright (C) 2010-2011 Red Hat Inc.
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -46,6 +46,7 @@ SOURCES = \
 	generator_haskell.ml \
 	generator_csharp.ml \
 	generator_php.ml \
+	generator_erlang.ml \
 	generator_bindtests.ml \
 	generator_errnostring.ml \
 	generator_main.ml
diff --git a/generator/generator_docstrings.ml b/generator/generator_docstrings.ml
index baccdd64..406bd55e 100644
--- a/generator/generator_docstrings.ml
+++ b/generator/generator_docstrings.ml
@@ -62,6 +62,7 @@ let copyright_years =
 (* Generate a header block in a number of standard styles. *)
 type comment_style =
     CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
+  | ErlangStyle
 type license = GPLv2plus | LGPLv2plus
 
 let generate_header ?(extra_inputs = []) comment license =
@@ -71,7 +72,8 @@ let generate_header ?(extra_inputs = []) comment license =
     | CPlusPlusStyle -> pr "// "; "//"
     | HashStyle ->      pr "# ";  "#"
     | OCamlStyle ->     pr "(* "; " *"
-    | HaskellStyle ->   pr "{- "; "  " in
+    | HaskellStyle ->   pr "{- "; "  "
+    | ErlangStyle ->    pr "%% "; "% " in
   pr "libguestfs generated file\n";
   pr "%s WARNING: THIS FILE IS GENERATED FROM:\n" c;
   List.iter (pr "%s   %s\n" c) inputs;
@@ -113,6 +115,7 @@ let generate_header ?(extra_inputs = []) comment license =
   (match comment with
    | CStyle -> pr " */\n"
    | CPlusPlusStyle
+   | ErlangStyle
    | HashStyle -> ()
    | OCamlStyle -> pr " *)\n"
    | HaskellStyle -> pr "-}\n"
diff --git a/generator/generator_erlang.ml b/generator/generator_erlang.ml
new file mode 100644
index 00000000..d166ef26
--- /dev/null
+++ b/generator/generator_erlang.ml
@@ -0,0 +1,438 @@
+(* libguestfs
+ * Copyright (C) 2011 Red Hat Inc.
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+(* Please read generator/README first. *)
+
+open Printf
+
+open Generator_types
+open Generator_utils
+open Generator_pr
+open Generator_docstrings
+open Generator_optgroups
+open Generator_actions
+open Generator_structs
+open Generator_c
+open Generator_events
+
+let rec generate_erlang_erl () =
+  generate_header ErlangStyle LGPLv2plus;
+
+  pr "-module(guestfs).\n";
+  pr "\n";
+  pr "-export([create/0, create/1, close/1, init/1]).\n";
+  pr "\n";
+
+  (* Export the public actions. *)
+  List.iter (
+    fun (name, (_, args, optargs), _, _, _, _, _) ->
+      let nr_args = List.length args in
+      if optargs = [] then
+        pr "-export([%s/%d]).\n" name (nr_args+1)
+      else
+        pr "-export([%s/%d, %s/%d]).\n" name (nr_args+1) name (nr_args+2)
+  ) all_functions_sorted;
+
+  pr "\n";
+
+  pr "\
+create() ->
+  create(\"erl-guestfs\").
+
+create(ExtProg) ->
+  G = spawn(?MODULE, init, [ExtProg]),
+  {ok, G}.
+
+close(G) ->
+  G ! close,
+  ok.
+
+call_port(G, Args) ->
+  G ! {call, self(), Args},
+  receive
+    {guestfs, Result} ->
+      Result
+  end.
+
+init(ExtProg) ->
+  process_flag(trap_exit, true),
+  Port = open_port({spawn, ExtProg}, [{packet, 4}, binary]),
+  loop(Port).
+loop(Port) ->
+  receive
+    {call, Caller, Args} ->
+      Port ! { self(), {command, term_to_binary(Args)}},
+      receive
+        {Port, {data, Result}} ->
+          Caller ! { guestfs, binary_to_term(Result)}
+      end,
+      loop(Port);
+    close ->
+      port_close(Port),
+      exit(normal);
+    { 'EXIT', Port, _ } ->
+      exit(port_terminated)
+  end.
+
+";
+
+  (* These bindings just marshal the parameters and call the back-end
+   * process which dispatches them to the port.
+   *)
+  List.iter (
+    fun (name, (_, args, optargs), _, _, _, _, _) ->
+      pr "%s(G" name;
+      List.iter (
+        fun arg ->
+          pr ", %s" (String.capitalize (name_of_argt arg))
+      ) args;
+      if optargs <> [] then
+        pr ", Optargs";
+      pr ") ->\n";
+
+      pr "  call_port(G, {%s" name;
+      List.iter (
+        fun arg ->
+          pr ", %s" (String.capitalize (name_of_argt arg))
+      ) args;
+      if optargs <> [] then
+        pr ", Optargs";
+      pr "}).\n";
+
+      (* For functions with optional arguments, make a variant that
+       * has no optarg array, which just calls the function above with
+       * an empty list as the final arg.
+       *)
+      if optargs <> [] then (
+        pr "%s(G" name;
+        List.iter (
+          fun arg ->
+            pr ", %s" (String.capitalize (name_of_argt arg))
+        ) args;
+        pr ") ->\n";
+
+        pr "  %s(G" name;
+        List.iter (
+          fun arg ->
+            pr ", %s" (String.capitalize (name_of_argt arg))
+        ) args;
+        pr ", []";
+        pr ").\n"
+      );
+
+      pr "\n"
+  ) all_functions_sorted
+
+and generate_erlang_c () =
+  generate_header CStyle GPLv2plus;
+
+  pr "\
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+
+#include <erl_interface.h>
+#include <ei.h>
+
+#include \"guestfs.h\"
+
+extern guestfs_h *g;
+
+extern ETERM *dispatch (ETERM *message);
+extern int atom_equals (ETERM *atom, const char *name);
+extern ETERM *make_error (const char *funname);
+extern ETERM *unknown_optarg (const char *funname, ETERM *optargname);
+extern ETERM *unknown_function (ETERM *fun);
+extern ETERM *make_string_list (char **r);
+extern ETERM *make_table (char **r);
+extern ETERM *make_bool (int r);
+extern char **get_string_list (ETERM *term);
+extern int get_bool (ETERM *term);
+extern void free_strings (char **r);
+
+#define ARG(i) (ERL_TUPLE_ELEMENT(message,(i)+1))
+
+";
+
+  (* Struct copy functions. *)
+  let emit_copy_list_function typ =
+    pr "static ETERM *\n";
+    pr "make_%s_list (const struct guestfs_%s_list *%ss)\n" typ typ typ;
+    pr "{\n";
+    pr "  ETERM *t[%ss->len];\n" typ;
+    pr "  size_t i;\n";
+    pr "\n";
+    pr "  for (i = 0; i < %ss->len; ++i)\n" typ;
+    pr "    t[i] = make_%s (&%ss->val[i]);\n" typ typ;
+    pr "\n";
+    pr "  return erl_mk_list (t, %ss->len);\n" typ;
+    pr "}\n";
+    pr "\n";
+  in
+
+  List.iter (
+    fun (typ, cols) ->
+      pr "static ETERM *\n";
+      pr "make_%s (const struct guestfs_%s *%s)\n" typ typ typ;
+      pr "{\n";
+      pr "  ETERM *t[%d];\n" (List.length cols);
+      pr "\n";
+      iteri (
+        fun i col ->
+          (match col with
+           | name, FString ->
+               pr "  t[%d] = erl_mk_string (%s->%s);\n" i typ name
+           | name, FBuffer ->
+               pr "  t[%d] = erl_mk_estring (%s->%s, %s->%s_len);\n"
+                 i typ name typ name
+           | name, FUUID ->
+               pr "  t[%d] = erl_mk_estring (%s->%s, 32);\n" i typ name
+           | name, (FBytes|FInt64|FUInt64) ->
+               pr "  t[%d] = erl_mk_longlong (%s->%s);\n" i typ name
+           | name, (FInt32|FUInt32) ->
+               pr "  t[%d] = erl_mk_int (%s->%s);\n" i typ name
+           | name, FOptPercent ->
+               pr "  if (%s->%s >= 0)\n" typ name;
+               pr "    t[%d] = erl_mk_float (%s->%s);\n" i typ name;
+               pr "  else\n";
+               pr "    t[%d] = erl_mk_atom (\"undefined\");\n" i;
+           | name, FChar ->
+               pr "  t[%d] = erl_mk_int (%s->%s);\n" i typ name
+          );
+      ) cols;
+      pr "\n";
+      pr "  return erl_mk_list (t, %d);\n" (List.length cols);
+      pr "}\n";
+      pr "\n";
+  ) structs;
+
+  (* Emit a copy_TYPE_list function definition only if that function is used. *)
+  List.iter (
+    function
+    | typ, (RStructListOnly | RStructAndList) ->
+        (* generate the function for typ *)
+        emit_copy_list_function typ
+    | typ, _ -> () (* empty *)
+  ) (rstructs_used_by all_functions);
+
+  (* The wrapper functions. *)
+  List.iter (
+    fun (name, ((ret, args, optargs) as style), _, _, _, _, _) ->
+      pr "static ETERM *\n";
+      pr "run_%s (ETERM *message)\n" name;
+      pr "{\n";
+
+      iteri (
+        fun i ->
+          function
+          | Pathname n
+          | Device n | Dev_or_Path n
+          | String n
+          | FileIn n
+          | FileOut n
+          | Key n ->
+            pr "  char *%s = erl_iolist_to_string (ARG (%d));\n" n i
+          | OptString n ->
+            pr "  char *%s;\n" n;
+            pr "  if (atom_equals (ARG (%d), \"undefined\"))\n" i;
+            pr "    %s = NULL;\n" n;
+            pr "  else\n";
+            pr "    %s = erl_iolist_to_string (ARG (%d));\n" n i
+          | BufferIn n ->
+            pr "  size_t %s_size = erl_iolist_length (ARG (%d));\n" n i;
+            pr "  char *%s = erl_iolist_to_string (ARG (%d));\n" n i
+          | StringList n | DeviceList n ->
+            pr "  char **%s = get_string_list (ARG (%d));\n" n i
+          | Bool n ->
+            pr "  int %s = get_bool (ARG (%d));\n" n i
+          | Int n ->
+            pr "  int %s = ERL_INT_VALUE (ARG (%d));\n" n i
+          | Int64 n ->
+            pr "  int64_t %s = ERL_LL_VALUE (ARG (%d));\n" n i
+          | Pointer (t, n) ->
+            assert false
+      ) args;
+
+      let uc_name = String.uppercase name in
+
+      (* Optional arguments. *)
+      if optargs <> [] then (
+        pr "\n";
+        pr "  struct guestfs_%s_argv optargs_s = { .bitmask = 0 };\n" name;
+        pr "  struct guestfs_%s_argv *optargs = &optargs_s;\n" name;
+        pr "  ETERM *optargst = ARG (%d);\n" (List.length args);
+        pr "  while (!ERL_IS_EMPTY_LIST (optargst)) {\n";
+        pr "    ETERM *hd = ERL_CONS_HEAD (optargst);\n";
+        pr "    ETERM *hd_name = ERL_TUPLE_ELEMENT (hd, 0);\n";
+        pr "    ETERM *hd_value = ERL_TUPLE_ELEMENT (hd, 1);\n";
+        pr "\n";
+        List.iter (
+          fun argt ->
+            let n = name_of_argt argt in
+            let uc_n = String.uppercase n in
+            pr "    if (atom_equals (hd_name, \"%s\")) {\n" n;
+            pr "      optargs_s.bitmask |= GUESTFS_%s_%s_BITMASK;\n" uc_name uc_n;
+            pr "      optargs_s.%s = " n;
+            (match argt with
+             | Bool _ -> pr "get_bool (hd_value)"
+             | Int _ -> pr "ERL_INT_VALUE (hd_value)"
+             | Int64 _ -> pr "ERL_LL_VALUE (hd_value)"
+             | String _ -> pr "erl_iolist_to_string (hd_value)"
+             | _ -> assert false
+            );
+            pr ";\n";
+            pr "    }\n";
+            pr "    else\n";
+        ) optargs;
+        pr "      return unknown_optarg (\"%s\", hd_name);\n" name;
+        pr "    optargst = ERL_CONS_TAIL (optargst);\n";
+        pr "  }\n";
+        pr "\n";
+      );
+
+      (match ret with
+       | RErr -> pr "  int r;\n"
+       | RInt _ -> pr "  int r;\n"
+       | RInt64 _ -> pr "  int64_t r;\n"
+       | RBool _ -> pr "  int r;\n"
+       | RConstString _ | RConstOptString _ ->
+           pr "  const char *r;\n"
+       | RString _ -> pr "  char *r;\n"
+       | RStringList _ ->
+           pr "  size_t i;\n";
+           pr "  char **r;\n"
+       | RStruct (_, typ) ->
+           pr "  struct guestfs_%s *r;\n" typ
+       | RStructList (_, typ) ->
+           pr "  struct guestfs_%s_list *r;\n" typ
+       | RHashtable _ ->
+           pr "  size_t i;\n";
+           pr "  char **r;\n"
+       | RBufferOut _ ->
+           pr "  char *r;\n";
+           pr "  size_t size;\n"
+      );
+      pr "\n";
+
+      if optargs = [] then
+        pr "  r = guestfs_%s " name
+      else
+        pr "  r = guestfs_%s_argv " name;
+      generate_c_call_args ~handle:"g" style;
+      pr ";\n";
+
+      (* Free strings if we copied them above. *)
+      List.iter (
+        function
+        | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+        | FileIn n | FileOut n | BufferIn n | Key n ->
+            pr "  free (%s);\n" n
+        | StringList n | DeviceList n ->
+            pr "  free_strings (%s);\n" n;
+        | Bool _ | Int _ | Int64 _ | Pointer _ -> ()
+      ) args;
+      List.iter (
+        function
+        | String n ->
+            let uc_n = String.uppercase n in
+            pr "  if ((optargs_s.bitmask & GUESTFS_%s_%s_BITMASK))\n"
+              uc_name uc_n;
+            pr "    free ((char *) optargs_s.%s);\n" n
+        | Bool _ | Int _ | Int64 _
+        | Pathname _ | Device _ | Dev_or_Path _ | OptString _
+        | FileIn _ | FileOut _ | BufferIn _ | Key _
+        | StringList _ | DeviceList _ | Pointer _ -> ()
+      ) optargs;
+
+      (match errcode_of_ret ret with
+       | `CannotReturnError -> ()
+       | `ErrorIsMinusOne ->
+           pr "  if (r == -1)\n";
+           pr "    return make_error (\"%s\");\n" name;
+       | `ErrorIsNULL ->
+           pr "  if (r == NULL)\n";
+           pr "    return make_error (\"%s\");\n" name;
+      );
+      pr "\n";
+
+      (match ret with
+       | RErr -> pr "  return erl_mk_atom (\"ok\");\n"
+       | RInt _ -> pr "  return erl_mk_int (r);\n"
+       | RInt64 _ -> pr "  return erl_mk_longlong (r);\n"
+       | RBool _ -> pr "  return make_bool (r);\n"
+       | RConstString _ -> pr "  return erl_mk_string (r);\n"
+       | RConstOptString _ ->
+           pr "  ETERM *rt;\n";
+           pr "  if (r)\n";
+           pr "    rt = erl_mk_string (r);\n";
+           pr "  else\n";
+           pr "    rt = erl_mk_atom (\"undefined\");\n";
+           pr "  return rt;\n"
+       | RString _ ->
+           pr "  ETERM *rt = erl_mk_string (r);\n";
+           pr "  free (r);\n";
+           pr "  return rt;\n"
+       | RStringList _ ->
+           pr "  ETERM *rt = make_string_list (r);\n";
+           pr "  free_strings (r);\n\n";
+           pr "  return rt;\n"
+       | RStruct (_, typ) ->
+           pr "  ETERM *rt = make_%s (r);\n" typ;
+           pr "  guestfs_free_%s (r);\n" typ;
+           pr "  return rt;\n"
+       | RStructList (_, typ) ->
+           pr "  ETERM *rt = make_%s_list (r);\n" typ;
+           pr "  guestfs_free_%s_list (r);\n" typ;
+           pr "  return rt;\n"
+       | RHashtable _ ->
+           pr "  ETERM *rt = make_table (r);\n";
+           pr "  free_strings (r);\n";
+           pr "  return rt;\n"
+       | RBufferOut _ ->
+           pr "  ETERM *rt = erl_mk_estring (r, size);\n";
+           pr "  free (r);\n";
+           pr "  return rt;\n"
+      );
+
+      pr "}\n";
+      pr "\n";
+  ) all_functions_sorted;
+
+  pr "\
+
+ETERM *
+dispatch (ETERM *message)
+{
+  ETERM *fun;
+
+  fun = ERL_TUPLE_ELEMENT (message, 0);
+
+  /* XXX We should use gperf here. */
+  ";
+
+  List.iter (
+    fun (name, (ret, args, optargs), _, _, _, _, _) ->
+      pr "if (atom_equals (fun, \"%s\"))\n" name;
+      pr "    return run_%s (message);\n" name;
+      pr "  else ";
+  ) all_functions_sorted;
+
+  pr "return unknown_function (fun);
+}
+";
diff --git a/generator/generator_main.ml b/generator/generator_main.ml
index f6e99a50..716e7b55 100644
--- a/generator/generator_main.ml
+++ b/generator/generator_main.ml
@@ -38,6 +38,7 @@ open Generator_java
 open Generator_haskell
 open Generator_csharp
 open Generator_php
+open Generator_erlang
 open Generator_bindtests
 open Generator_errnostring
 
@@ -132,6 +133,8 @@ Run it from the top source directory using the command
   output_to "csharp/Libguestfs.cs" generate_csharp;
   output_to "php/extension/php_guestfs_php.h" generate_php_h;
   output_to "php/extension/guestfs_php.c" generate_php_c;
+  output_to "erlang/guestfs.erl" generate_erlang_erl;
+  output_to "erlang/erl-guestfs.c" generate_erlang_c;
 
   (* Generate the list of files generated -- last. *)
   printf "generated %d lines of code\n" (get_lines_generated ());