X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=src%2Fgenerator.ml;h=dc0c9c14148cdd4f301e4224c680ccf184f8f614;hp=b3e397e864ea108fe6d483a4ed99e169090e033a;hb=8980c01b46eafcf4b5dc127e4696c2cbe1bff09f;hpb=2e2eb15df010bbcc605c86b0714ad1ca796fc96d diff --git a/src/generator.ml b/src/generator.ml index b3e397e..dc0c9c1 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 @@ -4810,9 +4810,13 @@ let check_functions () = let chan = ref Pervasives.stdout let pr fs = ksprintf (output_string !chan) 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 license = GPLv2plus | LGPLv2plus let generate_header ?(extra_inputs = []) comment license = let inputs = "src/generator.ml" :: extra_inputs in @@ -4826,10 +4830,10 @@ let generate_header ?(extra_inputs = []) comment license = 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 +4848,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; @@ -4996,7 +5000,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 +5158,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 +5206,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 +5216,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 +5226,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 +5578,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"; @@ -5588,7 +5592,7 @@ and generate_daemon_actions_h () = (* Generate the server-side stubs. *) and generate_daemon_actions () = - generate_header CStyle GPLv2; + generate_header CStyle GPLv2plus; pr "#include \n"; pr "\n"; @@ -5988,7 +5992,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 +6010,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 +6027,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 +6036,7 @@ and generate_daemon_optgroups_h () = (* Generate the tests. *) and generate_tests () = - generate_header CStyle GPLv2; + generate_header CStyle GPLv2plus; pr "\ #include @@ -6772,7 +6776,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 ( @@ -7136,7 +7140,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 +7379,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 +7421,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 +7449,7 @@ let () = (* Generate the OCaml bindings C implementation. *) and generate_ocaml_c () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ #include @@ -7797,7 +7801,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 +8156,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 +8268,7 @@ sub new { =head1 COPYRIGHT -Copyright (C) 2009 Red Hat Inc. +Copyright (C) %s Red Hat Inc. =head1 LICENSE @@ -8278,7 +8282,7 @@ L, L. =cut -" +" copyright_years and generate_perl_prototype name style = (match fst style with @@ -8312,7 +8316,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 +8705,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 +8858,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 +9130,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 +9316,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 +9347,7 @@ public class %s { pr "}\n" and generate_java_c () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ #include @@ -9697,7 +9701,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 +9711,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! @@ -9915,7 +9919,7 @@ and generate_haskell_prototype ~handle ?(hs = false) style = pr ")" and generate_bindtests () = - generate_header CStyle LGPLv2; + generate_header CStyle LGPLv2plus; pr "\ #include @@ -10067,7 +10071,7 @@ print_strings (char *const *argv) ) tests and generate_ocaml_bindtests () = - generate_header OCamlStyle GPLv2; + generate_header OCamlStyle GPLv2plus; pr "\ let () = @@ -10100,7 +10104,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 +10137,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 +10168,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 +10199,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 +10244,7 @@ public class Bindtests { " and generate_haskell_bindtests () = - generate_header HaskellStyle GPLv2; + generate_header HaskellStyle GPLv2plus; pr "\ module Bindtests where @@ -10688,7 +10692,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 +10735,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 +10826,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,170 +10878,53 @@ 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 "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.