X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=inline;f=src%2Fgenerator.ml;h=adccf9e8a292195046bdc1df0bfaf8c0bdee8fa1;hb=70c853d67a0cd5e54c821cd08726b91174517221;hp=4a9397d1f025ba6aa812d150074ed9c996b57073;hpb=de08dbc83037df26f48bdfda038531f457c192d9;p=libguestfs.git

diff --git a/src/generator.ml b/src/generator.ml
index 4a9397d..adccf9e 100755
--- a/src/generator.ml
+++ b/src/generator.ml
@@ -4815,16 +4815,18 @@ let copyright_years =
   if this_year > 2009 then sprintf "2009-%04d" this_year else "2009"
 
 (* Generate a header block in a number of standard styles. *)
-type comment_style = CStyle | HashStyle | OCamlStyle | HaskellStyle
+type comment_style =
+    CStyle | CPlusPlusStyle | HashStyle | OCamlStyle | HaskellStyle
 type license = GPLv2plus | LGPLv2plus
 
 let generate_header ?(extra_inputs = []) comment license =
   let inputs = "src/generator.ml" :: extra_inputs in
   let c = match comment with
-    | CStyle ->     pr "/* "; " *"
-    | HashStyle ->  pr "# ";  "#"
-    | OCamlStyle -> pr "(* "; " *"
-    | HaskellStyle -> pr "{- "; "  " in
+    | CStyle ->         pr "/* "; " *"
+    | CPlusPlusStyle -> pr "// "; "//"
+    | HashStyle ->      pr "# ";  "#"
+    | OCamlStyle ->     pr "(* "; " *"
+    | HaskellStyle ->   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;
@@ -4865,6 +4867,7 @@ let generate_header ?(extra_inputs = []) comment license =
   );
   (match comment with
    | CStyle -> pr " */\n"
+   | CPlusPlusStyle
    | HashStyle -> ()
    | OCamlStyle -> pr " *)\n"
    | HaskellStyle -> pr "-}\n"
@@ -9316,7 +9319,7 @@ and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false)
   pr "    throws LibGuestFSException";
   if semicolon then pr ";"
 
-and generate_java_struct jtyp cols =
+and generate_java_struct jtyp cols () =
   generate_header CStyle LGPLv2plus;
 
   pr "\
@@ -9918,6 +9921,242 @@ and generate_haskell_prototype ~handle ?(hs = false) style =
   );
   pr ")"
 
+and generate_csharp () =
+  generate_header CPlusPlusStyle LGPLv2plus;
+
+  (* XXX Make this configurable by the C# assembly users. *)
+  let library = "libguestfs.so.0" in
+
+  pr "\
+// These C# bindings are highly experimental at present.
+//
+// Firstly they only work on Linux (ie. Mono).  In order to get them
+// to work on Windows (ie. .Net) you would need to port the library
+// itself to Windows first.
+//
+// The second issue is that some calls are known to be incorrect and
+// can cause Mono to segfault.  Particularly: calls which pass or
+// return string[], or return any structure value.  This is because
+// we haven't worked out the correct way to do this from C#.
+//
+// The third issue is that when compiling you get a lot of warnings.
+// We are not sure whether the warnings are important or not.
+//
+// Fourthly we do not routinely build or test these bindings as part
+// of the make && make check cycle, which means that regressions might
+// go unnoticed.
+//
+// Suggestions and patches are welcome.
+
+// To compile:
+//
+// gmcs Libguestfs.cs
+// mono Libguestfs.exe
+//
+// (You'll probably want to add a Test class / static main function
+// otherwise this won't do anything useful).
+
+using System;
+using System.IO;
+using System.Runtime.InteropServices;
+using System.Runtime.Serialization;
+using System.Collections;
+
+namespace Guestfs
+{
+  class Error : System.ApplicationException
+  {
+    public Error (string message) : base (message) {}
+    protected Error (SerializationInfo info, StreamingContext context) {}
+  }
+
+  class Guestfs
+  {
+    IntPtr _handle;
+
+    [DllImport (\"%s\")]
+    static extern IntPtr guestfs_create ();
+
+    public Guestfs ()
+    {
+      _handle = guestfs_create ();
+      if (_handle == IntPtr.Zero)
+        throw new Error (\"could not create guestfs handle\");
+    }
+
+    [DllImport (\"%s\")]
+    static extern void guestfs_close (IntPtr h);
+
+    ~Guestfs ()
+    {
+      guestfs_close (_handle);
+    }
+
+    [DllImport (\"%s\")]
+    static extern string guestfs_last_error (IntPtr h);
+
+" library library library;
+
+  (* Generate C# structure bindings.  We prefix struct names with
+   * underscore because C# cannot have conflicting struct names and
+   * method names (eg. "class stat" and "stat").
+   *)
+  List.iter (
+    fun (typ, cols) ->
+      pr "    [StructLayout (LayoutKind.Sequential)]\n";
+      pr "    public class _%s {\n" typ;
+      List.iter (
+        function
+        | name, FChar -> pr "      char %s;\n" name
+        | name, FString -> pr "      string %s;\n" name
+        | name, FBuffer ->
+            pr "      uint %s_len;\n" name;
+            pr "      string %s;\n" name
+        | name, FUUID ->
+            pr "      [MarshalAs (UnmanagedType.ByValTStr, SizeConst=16)]\n";
+            pr "      string %s;\n" name
+        | name, FUInt32 -> pr "      uint %s;\n" name
+        | name, FInt32 -> pr "      int %s;\n" name
+        | name, (FUInt64|FBytes) -> pr "      ulong %s;\n" name
+        | name, FInt64 -> pr "      long %s;\n" name
+        | name, FOptPercent -> pr "      float %s; /* [0..100] or -1 */\n" name
+      ) cols;
+      pr "    }\n";
+      pr "\n"
+  ) structs;
+
+  (* Generate C# function bindings. *)
+  List.iter (
+    fun (name, style, _, _, _, shortdesc, _) ->
+      let rec csharp_return_type () =
+	match fst style with
+	| RErr -> "void"
+	| RBool n -> "bool"
+	| RInt n -> "int"
+	| RInt64 n -> "long"
+	| RConstString n
+	| RConstOptString n
+	| RString n
+	| RBufferOut n -> "string"
+	| RStruct (_,n) -> "_" ^ n
+	| RHashtable n -> "Hashtable"
+	| RStringList n -> "string[]"
+	| RStructList (_,n) -> sprintf "_%s[]" n
+
+      and c_return_type () =
+	match fst style with
+	| RErr
+	| RBool _
+	| RInt _ -> "int"
+	| RInt64 _ -> "long"
+	| RConstString _
+	| RConstOptString _
+	| RString _
+	| RBufferOut _ -> "string"
+	| RStruct (_,n) -> "_" ^ n
+	| RHashtable _
+	| RStringList _ -> "string[]"
+	| RStructList (_,n) -> sprintf "_%s[]" n
+    
+      and c_error_comparison () =
+	match fst style with
+	| RErr
+	| RBool _
+	| RInt _
+	| RInt64 _ -> "== -1"
+	| RConstString _
+	| RConstOptString _
+	| RString _
+	| RBufferOut _
+	| RStruct (_,_)
+	| RHashtable _
+	| RStringList _
+	| RStructList (_,_) -> "== null"
+    
+      and generate_extern_prototype () =
+	pr "    static extern %s guestfs_%s (IntPtr h"
+	  (c_return_type ()) name;
+	List.iter (
+	  function
+	  | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+	  | FileIn n | FileOut n ->
+              pr ", [In] string %s" n
+	  | StringList n | DeviceList n ->
+              pr ", [In] string[] %s" n
+	  | Bool n ->
+	      pr ", bool %s" n
+	  | Int n ->
+	      pr ", int %s" n
+	  | Int64 n ->
+	      pr ", long %s" n
+	) (snd style);
+	pr ");\n"
+
+      and generate_public_prototype () =
+	pr "    public %s %s (" (csharp_return_type ()) name;
+	let comma = ref false in
+	let next () =
+	  if !comma then pr ", ";
+	  comma := true
+	in
+	List.iter (
+	  function
+	  | Pathname n | Device n | Dev_or_Path n | String n | OptString n
+	  | FileIn n | FileOut n ->
+              next (); pr "string %s" n
+	  | StringList n | DeviceList n ->
+              next (); pr "string[] %s" n
+	  | Bool n ->
+	      next (); pr "bool %s" n
+	  | Int n ->
+	      next (); pr "int %s" n
+	  | Int64 n ->
+	      next (); pr "long %s" n
+	) (snd style);
+	pr ")\n"
+
+      and generate_call () =
+	pr "guestfs_%s (_handle" name;
+	List.iter (fun arg -> pr ", %s" (name_of_argt arg)) (snd style);
+	pr ");\n";
+      in
+
+      pr "    [DllImport (\"%s\")]\n" library;
+      generate_extern_prototype ();
+      pr "\n";
+      pr "    /// <summary>\n";
+      pr "    /// %s\n" shortdesc;
+      pr "    /// </summary>\n";
+      generate_public_prototype ();
+      pr "    {\n";
+      pr "      %s r;\n" (c_return_type ());
+      pr "      r = ";
+      generate_call ();
+      pr "      if (r %s)\n" (c_error_comparison ());
+      pr "        throw new Error (\"%s: \" + guestfs_last_error (_handle));\n"
+        name;
+      (match fst style with
+       | RErr -> ()
+       | RBool _ ->
+           pr "      return r != 0 ? true : false;\n"
+       | RHashtable _ ->
+           pr "      Hashtable rr = new Hashtable ();\n";
+           pr "      for (int i = 0; i < r.Length; i += 2)\n";
+           pr "        rr.Add (r[i], r[i+1]);\n";
+           pr "      return rr;\n"
+       | RInt _ | RInt64 _ | RConstString _ | RConstOptString _
+       | RString _ | RBufferOut _ | RStruct _ | RStringList _
+       | RStructList _ ->
+           pr "      return r;\n"
+      );
+      pr "    }\n";
+      pr "\n";
+  ) all_functions_sorted;
+
+  pr "  }
+}
+"
+
 and generate_bindtests () =
   generate_header CStyle LGPLv2plus;
 
@@ -10826,25 +11065,23 @@ and generate_max_proc_nr () =
 
   pr "%d\n" max_proc_nr
 
-let output_to filename =
+let output_to filename k =
   let filename_new = filename ^ ".new" in
   chan := open_out filename_new;
-  let close () =
-    close_out !chan;
-    chan := Pervasives.stdout;
-
-    (* Is the new file different from the current file? *)
-    if Sys.file_exists filename && files_equal filename filename_new then
-      unlink filename_new		(* same, so skip it *)
-    else (
-      (* different, overwrite old one *)
-      (try chmod filename 0o644 with Unix_error _ -> ());
-      rename filename_new filename;
-      chmod filename 0o444;
-      printf "written %s\n%!" filename;
-    )
-  in
-  close
+  k ();
+  close_out !chan;
+  chan := Pervasives.stdout;
+
+  (* Is the new file different from the current file? *)
+  if Sys.file_exists filename && files_equal filename filename_new then
+    unlink filename_new                 (* same, so skip it *)
+  else (
+    (* different, overwrite old one *)
+    (try chmod filename 0o644 with Unix_error _ -> ());
+    rename filename_new filename;
+    chmod filename 0o444;
+    printf "written %s\n%!" filename;
+  )
 
 let perror msg = function
   | Unix_error (err, _, _) ->
@@ -10880,170 +11117,54 @@ Run it from the top source directory using the command
 
   check_functions ();
 
-  let close = output_to "src/guestfs_protocol.x" in
-  generate_xdr ();
-  close ();
-
-  let close = output_to "src/guestfs-structs.h" in
-  generate_structs_h ();
-  close ();
-
-  let close = output_to "src/guestfs-actions.h" in
-  generate_actions_h ();
-  close ();
-
-  let close = output_to "src/guestfs-internal-actions.h" in
-  generate_internal_actions_h ();
-  close ();
-
-  let close = output_to "src/guestfs-actions.c" in
-  generate_client_actions ();
-  close ();
-
-  let close = output_to "daemon/actions.h" in
-  generate_daemon_actions_h ();
-  close ();
-
-  let close = output_to "daemon/stubs.c" in
-  generate_daemon_actions ();
-  close ();
-
-  let close = output_to "daemon/names.c" in
-  generate_daemon_names ();
-  close ();
-
-  let close = output_to "daemon/optgroups.c" in
-  generate_daemon_optgroups_c ();
-  close ();
-
-  let close = output_to "daemon/optgroups.h" in
-  generate_daemon_optgroups_h ();
-  close ();
-
-  let close = output_to "capitests/tests.c" in
-  generate_tests ();
-  close ();
-
-  let close = output_to "src/guestfs-bindtests.c" in
-  generate_bindtests ();
-  close ();
-
-  let close = output_to "fish/cmds.c" in
-  generate_fish_cmds ();
-  close ();
-
-  let close = output_to "fish/completion.c" in
-  generate_fish_completion ();
-  close ();
-
-  let close = output_to "guestfs-structs.pod" in
-  generate_structs_pod ();
-  close ();
-
-  let close = output_to "guestfs-actions.pod" in
-  generate_actions_pod ();
-  close ();
-
-  let close = output_to "guestfs-availability.pod" in
-  generate_availability_pod ();
-  close ();
-
-  let close = output_to "guestfish-actions.pod" in
-  generate_fish_actions_pod ();
-  close ();
-
-  let close = output_to "ocaml/guestfs.mli" in
-  generate_ocaml_mli ();
-  close ();
-
-  let close = output_to "ocaml/guestfs.ml" in
-  generate_ocaml_ml ();
-  close ();
-
-  let close = output_to "ocaml/guestfs_c_actions.c" in
-  generate_ocaml_c ();
-  close ();
-
-  let close = output_to "ocaml/bindtests.ml" in
-  generate_ocaml_bindtests ();
-  close ();
-
-  let close = output_to "ocaml/guestfs_inspector.mli" in
-  generate_ocaml_inspector_mli ();
-  close ();
-
-  let close = output_to "ocaml/guestfs_inspector.ml" in
-  generate_ocaml_inspector_ml ();
-  close ();
-
-  let close = output_to "perl/Guestfs.xs" in
-  generate_perl_xs ();
-  close ();
-
-  let close = output_to "perl/lib/Sys/Guestfs.pm" in
-  generate_perl_pm ();
-  close ();
-
-  let close = output_to "perl/bindtests.pl" in
-  generate_perl_bindtests ();
-  close ();
-
-  let close = output_to "python/guestfs-py.c" in
-  generate_python_c ();
-  close ();
-
-  let close = output_to "python/guestfs.py" in
-  generate_python_py ();
-  close ();
-
-  let close = output_to "python/bindtests.py" in
-  generate_python_bindtests ();
-  close ();
-
-  let close = output_to "ruby/ext/guestfs/_guestfs.c" in
-  generate_ruby_c ();
-  close ();
-
-  let close = output_to "ruby/bindtests.rb" in
-  generate_ruby_bindtests ();
-  close ();
-
-  let close = output_to "java/com/redhat/et/libguestfs/GuestFS.java" in
-  generate_java_java ();
-  close ();
+  output_to "src/guestfs_protocol.x" generate_xdr;
+  output_to "src/guestfs-structs.h" generate_structs_h;
+  output_to "src/guestfs-actions.h" generate_actions_h;
+  output_to "src/guestfs-internal-actions.h" generate_internal_actions_h;
+  output_to "src/guestfs-actions.c" generate_client_actions;
+  output_to "src/guestfs-bindtests.c" generate_bindtests;
+  output_to "src/guestfs-structs.pod" generate_structs_pod;
+  output_to "src/guestfs-actions.pod" generate_actions_pod;
+  output_to "src/guestfs-availability.pod" generate_availability_pod;
+  output_to "daemon/actions.h" generate_daemon_actions_h;
+  output_to "daemon/stubs.c" generate_daemon_actions;
+  output_to "daemon/names.c" generate_daemon_names;
+  output_to "daemon/optgroups.c" generate_daemon_optgroups_c;
+  output_to "daemon/optgroups.h" generate_daemon_optgroups_h;
+  output_to "capitests/tests.c" generate_tests;
+  output_to "fish/cmds.c" generate_fish_cmds;
+  output_to "fish/completion.c" generate_fish_completion;
+  output_to "fish/guestfish-actions.pod" generate_fish_actions_pod;
+  output_to "ocaml/guestfs.mli" generate_ocaml_mli;
+  output_to "ocaml/guestfs.ml" generate_ocaml_ml;
+  output_to "ocaml/guestfs_c_actions.c" generate_ocaml_c;
+  output_to "ocaml/bindtests.ml" generate_ocaml_bindtests;
+  output_to "ocaml/guestfs_inspector.mli" generate_ocaml_inspector_mli;
+  output_to "ocaml/guestfs_inspector.ml" generate_ocaml_inspector_ml;
+  output_to "perl/Guestfs.xs" generate_perl_xs;
+  output_to "perl/lib/Sys/Guestfs.pm" generate_perl_pm;
+  output_to "perl/bindtests.pl" generate_perl_bindtests;
+  output_to "python/guestfs-py.c" generate_python_c;
+  output_to "python/guestfs.py" generate_python_py;
+  output_to "python/bindtests.py" generate_python_bindtests;
+  output_to "ruby/ext/guestfs/_guestfs.c" generate_ruby_c;
+  output_to "ruby/bindtests.rb" generate_ruby_bindtests;
+  output_to "java/com/redhat/et/libguestfs/GuestFS.java" generate_java_java;
 
   List.iter (
     fun (typ, jtyp) ->
       let cols = cols_of_struct typ in
       let filename = sprintf "java/com/redhat/et/libguestfs/%s.java" jtyp in
-      let close = output_to filename in
-      generate_java_struct jtyp cols;
-      close ();
+      output_to filename (generate_java_struct jtyp cols);
   ) java_structs;
 
-  let close = output_to "java/Makefile.inc" in
-  generate_java_makefile_inc ();
-  close ();
-
-  let close = output_to "java/com_redhat_et_libguestfs_GuestFS.c" in
-  generate_java_c ();
-  close ();
-
-  let close = output_to "java/Bindtests.java" in
-  generate_java_bindtests ();
-  close ();
-
-  let close = output_to "haskell/Guestfs.hs" in
-  generate_haskell_hs ();
-  close ();
-
-  let close = output_to "haskell/Bindtests.hs" in
-  generate_haskell_bindtests ();
-  close ();
-
-  let close = output_to "src/MAX_PROC_NR" in
-  generate_max_proc_nr ();
-  close ();
+  output_to "java/Makefile.inc" generate_java_makefile_inc;
+  output_to "java/com_redhat_et_libguestfs_GuestFS.c" generate_java_c;
+  output_to "java/Bindtests.java" generate_java_bindtests;
+  output_to "haskell/Guestfs.hs" generate_haskell_hs;
+  output_to "haskell/Bindtests.hs" generate_haskell_bindtests;
+  output_to "csharp/Libguestfs.cs" generate_csharp;
+  output_to "src/MAX_PROC_NR" generate_max_proc_nr;
 
   (* Always generate this file last, and unconditionally.  It's used
    * by the Makefile to know when we must re-run the generator.