X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fgenerator.ml;h=4bf4b0f409871934346f0c2c220d8b1cefcc5388;hb=008cbfcc15aa051c2a84d20b3be4caaab77904ea;hp=10381dcb00dad0d79bfe2832d6e9b002cbfe7adc;hpb=b177f05ed6e65a9fe1fddc6ca602edcb912ac363;p=libguestfs.git diff --git a/src/generator.ml b/src/generator.ml index 10381dc..4bf4b0f 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -4577,6 +4577,13 @@ let mapi f xs = in loop 0 xs +let count_chars c str = + let count = ref 0 in + for i = 0 to String.length str - 1 do + if c = String.unsafe_get str i then incr count + done; + !count + let name_of_argt = function | Pathname n | Device n | Dev_or_Path n | String n | OptString n | StringList n | DeviceList n | Bool n | Int n | Int64 n @@ -4808,23 +4815,32 @@ let check_functions () = (* 'pr' prints to the current output file. *) let chan = ref Pervasives.stdout -let pr fs = ksprintf (output_string !chan) fs +let lines = ref 0 +let pr fs = + ksprintf + (fun str -> + let i = count_chars '\n' str in + lines := !lines + i; + output_string !chan str + ) fs let copyright_years = let this_year = 1900 + (localtime (time ())).tm_year in 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 +4881,7 @@ let generate_header ?(extra_inputs = []) comment license = ); (match comment with | CStyle -> pr " */\n" + | CPlusPlusStyle | HashStyle -> () | OCamlStyle -> pr " *)\n" | HaskellStyle -> pr "-}\n" @@ -5590,6 +5607,51 @@ and generate_daemon_actions_h () = name style; ) daemon_functions +(* Generate the linker script which controls the visibility of + * symbols in the public ABI and ensures no other symbols get + * exported accidentally. + *) +and generate_linker_script () = + generate_header HashStyle GPLv2plus; + + let globals = [ + "guestfs_create"; + "guestfs_close"; + "guestfs_get_error_handler"; + "guestfs_get_out_of_memory_handler"; + "guestfs_last_error"; + "guestfs_set_error_handler"; + "guestfs_set_launch_done_callback"; + "guestfs_set_log_message_callback"; + "guestfs_set_out_of_memory_handler"; + "guestfs_set_subprocess_quit_callback"; + + (* Unofficial parts of the API: the bindings code use these + * functions, so it is useful to export them. + *) + "guestfs_safe_calloc"; + "guestfs_safe_malloc"; + ] in + let functions = + List.map (fun (name, _, _, _, _, _, _) -> "guestfs_" ^ name) + all_functions in + let structs = + List.concat ( + List.map (fun (typ, _) -> + ["guestfs_free_" ^ typ; "guestfs_free_" ^ typ ^ "_list"]) + structs + ) in + let globals = List.sort compare (globals @ functions @ structs) in + + pr "{\n"; + pr " global:\n"; + List.iter (pr " %s;\n") globals; + pr "\n"; + + pr " local:\n"; + pr " *;\n"; + pr "};\n" + (* Generate the server-side stubs. *) and generate_daemon_actions () = generate_header CStyle GPLv2plus; @@ -9918,6 +9980,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 " /// \n"; + pr " /// %s\n" shortdesc; + pr " /// \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; @@ -10883,19 +11181,21 @@ Run it from the top source directory using the command 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 "src/MAX_PROC_NR" generate_max_proc_nr; + output_to "src/libguestfs.syms" generate_linker_script; 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 "src/guestfs-bindtests.c" generate_bindtests; output_to "fish/cmds.c" generate_fish_cmds; output_to "fish/completion.c" generate_fish_completion; - output_to "guestfs-structs.pod" generate_structs_pod; - output_to "guestfs-actions.pod" generate_actions_pod; - output_to "guestfs-availability.pod" generate_availability_pod; - output_to "guestfish-actions.pod" generate_fish_actions_pod; + 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; @@ -10924,11 +11224,13 @@ Run it from the top source directory using the command 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 "src/MAX_PROC_NR" generate_max_proc_nr; + output_to "csharp/Libguestfs.cs" generate_csharp; (* Always generate this file last, and unconditionally. It's used * by the Makefile to know when we must re-run the generator. *) let chan = open_out "src/stamp-generator" in fprintf chan "1\n"; - close_out chan + close_out chan; + + printf "generated %d lines of code\n" !lines