X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=src%2Fgenerator.ml;h=58c39e611f890712fe465710814e2f2c0a91a2b8;hb=3c973b8a960dfde022a7d49b30b8c6d504a182e3;hp=b3e397e864ea108fe6d483a4ed99e169090e033a;hpb=2e2eb15df010bbcc605c86b0714ad1ca796fc96d;p=libguestfs.git diff --git a/src/generator.ml b/src/generator.ml index b3e397e..58c39e6 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -1,6 +1,6 @@ #!/usr/bin/env ocaml (* libguestfs - * Copyright (C) 2009 Red Hat Inc. + * Copyright (C) 2009-2010 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 @@ -1326,7 +1326,11 @@ as necessary. This is like the C shell command."); "change file mode", "\ Change the mode (permissions) of C to C. Only -numeric modes are supported."); +numeric modes are supported. + +I: When using this command from guestfish, C +by default would be decimal, unless you prefix it with +C<0> to get octal, ie. use C<0700> not C<700>."); ("chown", (RErr, [Int "owner"; Int "group"; Pathname "path"]), 35, [], [], (* XXX Need stat command to test *) @@ -4188,6 +4192,18 @@ If the destination is a device, it must be as large or larger than the source file or device, otherwise the copy will fail. This command cannot do partial copies."); + ("filesize", (RInt64 "size", [Pathname "file"]), 218, [], + [InitBasicFS, Always, TestOutputInt ( + [["write_file"; "/file"; "hello, world"; "0"]; + ["filesize"; "/file"]], 12)], + "return the size of the file in bytes", + "\ +This command returns the size of C in bytes. + +To get other stats about a file, use C, C, +C, C etc. +To get the size of block devices, use C."); + ] let all_functions = non_daemon_functions @ daemon_functions @@ -4577,6 +4593,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,28 +4831,41 @@ 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 license = GPLv2 | LGPLv2 +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; pr "%s ANY CHANGES YOU MAKE TO THIS FILE WILL BE LOST.\n" c; pr "%s\n" c; - pr "%s Copyright (C) 2009 Red Hat Inc.\n" c; + pr "%s Copyright (C) %s Red Hat Inc.\n" c copyright_years; pr "%s\n" c; (match license with - | GPLv2 -> + | GPLv2plus -> pr "%s This program is free software; you can redistribute it and/or modify\n" c; pr "%s it under the terms of the GNU General Public License as published by\n" c; pr "%s the Free Software Foundation; either version 2 of the License, or\n" c; @@ -4844,7 +4880,7 @@ let generate_header ?(extra_inputs = []) comment license = pr "%s with this program; if not, write to the Free Software Foundation, Inc.,\n" c; pr "%s 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.\n" c; - | LGPLv2 -> + | LGPLv2plus -> pr "%s This library is free software; you can redistribute it and/or\n" c; pr "%s modify it under the terms of the GNU Lesser General Public\n" c; pr "%s License as published by the Free Software Foundation; either\n" c; @@ -4861,6 +4897,7 @@ let generate_header ?(extra_inputs = []) comment license = ); (match comment with | CStyle -> pr " */\n" + | CPlusPlusStyle | HashStyle -> () | OCamlStyle -> pr " *)\n" | HaskellStyle -> pr "-}\n" @@ -4996,7 +5033,7 @@ and generate_availability_pod () = * This header is NOT exported to clients, but see also generate_structs_h. *) and generate_xdr () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; (* This has to be defined to get around a limitation in Sun's rpcgen. *) pr "typedef string str<>;\n"; @@ -5154,7 +5191,7 @@ struct guestfs_chunk { (* Generate the guestfs-structs.h file. *) and generate_structs_h () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; (* This is a public exported header file containing various * structures. The structures are carefully written to have @@ -5202,7 +5239,7 @@ and generate_structs_h () = (* Generate the guestfs-actions.h file. *) and generate_actions_h () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; List.iter ( fun (shortname, style, _, _, _, _, _) -> let name = "guestfs_" ^ shortname in @@ -5212,7 +5249,7 @@ and generate_actions_h () = (* Generate the guestfs-internal-actions.h file. *) and generate_internal_actions_h () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; List.iter ( fun (shortname, style, _, _, _, _, _) -> let name = "guestfs__" ^ shortname in @@ -5222,7 +5259,7 @@ and generate_internal_actions_h () = (* Generate the client-side dispatch stubs. *) and generate_client_actions () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ #include @@ -5574,7 +5611,7 @@ check_state (guestfs_h *g, const char *caller) (* Generate daemon/actions.h. *) and generate_daemon_actions_h () = - generate_header CStyle GPLv2; + generate_header CStyle GPLv2plus; pr "#include \"../src/guestfs_protocol.h\"\n"; pr "\n"; @@ -5586,9 +5623,54 @@ 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 GPLv2; + generate_header CStyle GPLv2plus; pr "#include \n"; pr "\n"; @@ -5988,7 +6070,7 @@ and generate_daemon_actions () = (* Generate a list of function names, for debugging in the daemon.. *) and generate_daemon_names () = - generate_header CStyle GPLv2; + generate_header CStyle GPLv2plus; pr "#include \n"; pr "\n"; @@ -6006,7 +6088,7 @@ and generate_daemon_names () = * guestfs_available. *) and generate_daemon_optgroups_c () = - generate_header CStyle GPLv2; + generate_header CStyle GPLv2plus; pr "#include \n"; pr "\n"; @@ -6023,7 +6105,7 @@ and generate_daemon_optgroups_c () = pr "};\n" and generate_daemon_optgroups_h () = - generate_header CStyle GPLv2; + generate_header CStyle GPLv2plus; List.iter ( fun (group, _) -> @@ -6032,7 +6114,7 @@ and generate_daemon_optgroups_h () = (* Generate the tests. *) and generate_tests () = - generate_header CStyle GPLv2; + generate_header CStyle GPLv2plus; pr "\ #include @@ -6772,7 +6854,7 @@ and c_quote str = (* Generate a lot of different functions for guestfish. *) and generate_fish_cmds () = - generate_header CStyle GPLv2; + generate_header CStyle GPLv2plus; let all_functions = List.filter ( @@ -6783,6 +6865,8 @@ and generate_fish_cmds () = fun (_, _, _, flags, _, _, _) -> not (List.mem NotInFish flags) ) all_functions_sorted in + pr "#include \n"; + pr "\n"; pr "#include \n"; pr "#include \n"; pr "#include \n"; @@ -6790,6 +6874,8 @@ and generate_fish_cmds () = pr "\n"; pr "#include \n"; pr "#include \"c-ctype.h\"\n"; + pr "#include \"full-write.h\"\n"; + pr "#include \"xstrtol.h\"\n"; pr "#include \"fish.h\"\n"; pr "\n"; @@ -7001,6 +7087,34 @@ and generate_fish_cmds () = pr " fprintf (stderr, _(\"type 'help %%s' for help on %%s\\n\"), cmd, cmd);\n"; pr " return -1;\n"; pr " }\n"; + + let parse_integer fn fntyp rtyp range name i = + pr " {\n"; + pr " strtol_error xerr;\n"; + pr " %s r;\n" fntyp; + pr "\n"; + pr " xerr = %s (argv[%d], NULL, 0, &r, \"\");\n" fn i; + pr " if (xerr != LONGINT_OK) {\n"; + pr " fprintf (stderr,\n"; + pr " _(\"%%s: %%s: invalid integer parameter (%%s returned %%d)\\n\"),\n"; + pr " cmd, \"%s\", \"%s\", xerr);\n" name fn; + pr " return -1;\n"; + pr " }\n"; + (match range with + | None -> () + | Some (min, max, comment) -> + pr " /* %s */\n" comment; + pr " if (r < %s || r > %s) {\n" min max; + pr " fprintf (stderr, _(\"%%s: %%s: integer out of range\\n\"), cmd, \"%s\");\n" + name; + pr " return -1;\n"; + pr " }\n"; + pr " /* The check above should ensure this assignment does not overflow. */\n"; + ); + pr " %s = r;\n" name; + pr " }\n"; + in + iteri ( fun i -> function @@ -7026,9 +7140,15 @@ and generate_fish_cmds () = | Bool name -> pr " %s = is_true (argv[%d]) ? 1 : 0;\n" name i | Int name -> - pr " %s = atoi (argv[%d]);\n" name i + let range = + let min = "(-(2LL<<30))" + and max = "((2LL<<30)-1)" + and comment = + "The Int type in the generator is a signed 31 bit int." in + Some (min, max, comment) in + parse_integer "xstrtol" "long" "int" range name i | Int64 name -> - pr " %s = atoll (argv[%d]);\n" name i + parse_integer "xstrtoll" "long long" "int64_t" None name i ) (snd style); (* Call C API function. *) @@ -7099,7 +7219,11 @@ and generate_fish_cmds () = pr " return 0;\n" | RBufferOut _ -> pr " if (r == NULL) return -1;\n"; - pr " fwrite (r, size, 1, stdout);\n"; + pr " if (full_write (1, r, size) != size) {\n"; + pr " perror (\"write\");\n"; + pr " free (r);\n"; + pr " return -1;\n"; + pr " }\n"; pr " free (r);\n"; pr " return 0;\n" ); @@ -7136,7 +7260,7 @@ and generate_fish_cmds () = (* Readline completion for guestfish. *) and generate_fish_completion () = - generate_header CStyle GPLv2; + generate_header CStyle GPLv2plus; let all_functions = List.filter ( @@ -7375,7 +7499,7 @@ and generate_c_call_args ?handle ?(decl = false) style = (* Generate the OCaml bindings interface. *) and generate_ocaml_mli () = - generate_header OCamlStyle LGPLv2; + generate_header OCamlStyle LGPLv2plus; pr "\ (** For API documentation you should refer to the C API @@ -7417,7 +7541,7 @@ val close : t -> unit (* Generate the OCaml bindings implementation. *) and generate_ocaml_ml () = - generate_header OCamlStyle LGPLv2; + generate_header OCamlStyle LGPLv2plus; pr "\ type t @@ -7445,7 +7569,7 @@ let () = (* Generate the OCaml bindings C implementation. *) and generate_ocaml_c () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ #include @@ -7797,7 +7921,7 @@ and generate_ocaml_prototype ?(is_external = false) name style = (* Generate Perl xs code, a sort of crazy variation of C with macros. *) and generate_perl_xs () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ #include \"EXTERN.h\" @@ -8152,7 +8276,7 @@ and generate_perl_struct_code typ cols name style n do_cleanups = (* Generate Sys/Guestfs.pm. *) and generate_perl_pm () = - generate_header HashStyle LGPLv2; + generate_header HashStyle LGPLv2plus; pr "\ =pod @@ -8264,7 +8388,7 @@ sub new { =head1 COPYRIGHT -Copyright (C) 2009 Red Hat Inc. +Copyright (C) %s Red Hat Inc. =head1 LICENSE @@ -8278,7 +8402,7 @@ L, L. =cut -" +" copyright_years and generate_perl_prototype name style = (match fst style with @@ -8312,7 +8436,7 @@ and generate_perl_prototype name style = (* Generate Python C module. *) and generate_python_c () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ #include @@ -8701,7 +8825,7 @@ initlibguestfsmod (void) (* Generate Python module. *) and generate_python_py () = - generate_header HashStyle LGPLv2; + generate_header HashStyle LGPLv2plus; pr "\ u\"\"\"Python bindings for libguestfs @@ -8854,7 +8978,7 @@ and pod2text ~width name longdesc = (* Generate ruby bindings. *) and generate_ruby_c () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ #include @@ -9126,7 +9250,7 @@ and generate_ruby_struct_list_code typ cols = (* Generate Java bindings GuestFS.java file. *) and generate_java_java () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ package com.redhat.et.libguestfs; @@ -9312,8 +9436,8 @@ and generate_java_prototype ?(public=false) ?(privat=false) ?(native=false) pr " throws LibGuestFSException"; if semicolon then pr ";" -and generate_java_struct jtyp cols = - generate_header CStyle LGPLv2; +and generate_java_struct jtyp cols () = + generate_header CStyle LGPLv2plus; pr "\ package com.redhat.et.libguestfs; @@ -9343,7 +9467,7 @@ public class %s { pr "}\n" and generate_java_c () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ #include @@ -9697,7 +9821,7 @@ and generate_java_struct_list_return typ jtyp cols = pr " return jr;\n" and generate_java_makefile_inc () = - generate_header HashStyle GPLv2; + generate_header HashStyle GPLv2plus; pr "java_built_sources = \\\n"; List.iter ( @@ -9707,7 +9831,7 @@ and generate_java_makefile_inc () = pr "\tcom/redhat/et/libguestfs/GuestFS.java\n" and generate_haskell_hs () = - generate_header HaskellStyle LGPLv2; + generate_header HaskellStyle LGPLv2plus; (* XXX We only know how to generate partial FFI for Haskell * at the moment. Please help out! @@ -9914,8 +10038,244 @@ 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 LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ #include @@ -10067,7 +10427,7 @@ print_strings (char *const *argv) ) tests and generate_ocaml_bindtests () = - generate_header OCamlStyle GPLv2; + generate_header OCamlStyle GPLv2plus; pr "\ let () = @@ -10100,7 +10460,7 @@ let () = and generate_perl_bindtests () = pr "#!/usr/bin/perl -w\n"; - generate_header HashStyle GPLv2; + generate_header HashStyle GPLv2plus; pr "\ use strict; @@ -10133,7 +10493,7 @@ my $g = Sys::Guestfs->new (); pr "print \"EOF\\n\"\n" and generate_python_bindtests () = - generate_header HashStyle GPLv2; + generate_header HashStyle GPLv2plus; pr "\ import guestfs @@ -10164,7 +10524,7 @@ g = guestfs.GuestFS () pr "print \"EOF\"\n" and generate_ruby_bindtests () = - generate_header HashStyle GPLv2; + generate_header HashStyle GPLv2plus; pr "\ require 'guestfs' @@ -10195,7 +10555,7 @@ g = Guestfs::create() pr "print \"EOF\\n\"\n" and generate_java_bindtests () = - generate_header CStyle GPLv2; + generate_header CStyle GPLv2plus; pr "\ import com.redhat.et.libguestfs.*; @@ -10240,7 +10600,7 @@ public class Bindtests { " and generate_haskell_bindtests () = - generate_header HaskellStyle GPLv2; + generate_header HaskellStyle GPLv2plus; pr "\ module Bindtests where @@ -10688,7 +11048,7 @@ let generate_parsers xs = (* Generate ocaml/guestfs_inspector.mli. *) let generate_ocaml_inspector_mli () = - generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2; + generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus; pr "\ (** This is an OCaml language binding to the external [virt-inspector] @@ -10731,7 +11091,7 @@ val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems (* Generate ocaml/guestfs_inspector.ml. *) let generate_ocaml_inspector_ml () = - generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2; + generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus; pr "open Unix\n"; pr "\n"; @@ -10822,25 +11182,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, _, _) -> @@ -10876,174 +11234,61 @@ 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 "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 "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; (* 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