From: Richard Jones Date: Mon, 2 Aug 2010 22:29:43 +0000 (+0100) Subject: Remove old ocaml-inspector code. X-Git-Tag: 1.5.3~1 X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=commitdiff_plain;h=ad373a4d6c2367b78b0dd337c1797f889a94b713 Remove old ocaml-inspector code. Not used by anyone, didn't work well, and replaced now by the C inspection APIs. --- diff --git a/ocaml/Makefile.am b/ocaml/Makefile.am index 99bb390..5c7b929 100644 --- a/ocaml/Makefile.am +++ b/ocaml/Makefile.am @@ -20,15 +20,12 @@ include $(top_srcdir)/subdir-rules.mk generator_built = \ guestfs.mli \ guestfs.ml \ - guestfs_inspector.mli \ - guestfs_inspector.ml \ guestfs_c_actions.c \ bindtests.ml EXTRA_DIST = \ $(generator_built) \ guestfs_c.c guestfs_c.h \ - guestfs_inspector.mli guestfs_inspector.ml \ .depend META.in \ run-bindtests \ t/*.ml @@ -45,7 +42,7 @@ if HAVE_XML_LIGHT noinst_DATA = mlguestfs.cma mlguestfs.cmxa META -OBJS = guestfs_c.o guestfs_c_actions.o guestfs.cmo guestfs_inspector.cmo +OBJS = guestfs_c.o guestfs_c_actions.o guestfs.cmo XOBJS = $(OBJS:.cmo=.cmx) mlguestfs.cma: $(OBJS) @@ -67,10 +64,10 @@ TESTS_ENVIRONMENT = \ TESTS = run-bindtests \ t/guestfs_005_load t/guestfs_010_launch t/guestfs_050_lvcreate \ - t/guestfs_060_readdir t/guestfs_070_threads t/guestfs_500_inspect + t/guestfs_060_readdir t/guestfs_070_threads noinst_DATA += bindtests \ t/guestfs_005_load t/guestfs_010_launch t/guestfs_050_lvcreate \ - t/guestfs_060_readdir t/guestfs_070_threads t/guestfs_500_inspect + t/guestfs_060_readdir t/guestfs_070_threads bindtests: bindtests.cmx mlguestfs.cmxa mkdir -p t @@ -96,10 +93,6 @@ t/guestfs_070_threads: t/guestfs_070_threads.cmx mlguestfs.cmxa mkdir -p t $(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/src/.libs -I . -package unix,threads -thread -linkpkg mlguestfs.cmxa $< -o $@ -t/guestfs_500_inspect: t/guestfs_500_inspect.cmx mlguestfs.cmxa - mkdir -p t - $(OCAMLFIND) ocamlopt -cclib -L$(top_builddir)/src/.libs -I . -package xml-light,unix -linkpkg mlguestfs.cmxa $< -o $@ - # Need to rebuild the tests from source if the main library has # changed at all, otherwise we get inconsistent assumptions. t/guestfs_070_threads.cmx: t/guestfs_070_threads.ml mlguestfs.cmxa diff --git a/ocaml/t/guestfs_500_inspect.ml b/ocaml/t/guestfs_500_inspect.ml deleted file mode 100644 index ec1071a..0000000 --- a/ocaml/t/guestfs_500_inspect.ml +++ /dev/null @@ -1,42 +0,0 @@ -(* libguestfs OCaml bindings - * Copyright (C) 2009 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., 675 Mass Ave, Cambridge, MA 02139, USA. - *) - -open Unix - -let (//) = Filename.concat -let dotdot = Filename.parent_dir_name - -let read_file name = - let chan = open_in name in - let lines = ref [] in - let lines = - try while true do lines := input_line chan :: !lines done; [] - with End_of_file -> List.rev !lines in - close_in chan; - String.concat "" lines - -let parse name = - let xml = read_file name in - let os = Guestfs_inspector.inspect ~xml [] in - os - -let () = - ignore (parse (dotdot // "inspector" // "example1.xml")); - ignore (parse (dotdot // "inspector" // "example2.xml")); - ignore (parse (dotdot // "inspector" // "example3.xml")); - ignore (parse (dotdot // "inspector" // "example4.xml")) diff --git a/src/generator.ml b/src/generator.ml index a879806..e18fa38 100755 --- a/src/generator.ml +++ b/src/generator.ml @@ -12195,494 +12195,6 @@ and generate_lang_bindtests call = (* XXX Add here tests of the return and error functions. *) -(* Code to generator bindings for virt-inspector. Currently only - * implemented for OCaml code (for virt-p2v 2.0). - *) -let rng_input = "inspector/virt-inspector.rng" - -(* Read the input file and parse it into internal structures. This is - * by no means a complete RELAX NG parser, but is just enough to be - * able to parse the specific input file. - *) -type rng = - | Element of string * rng list (* *) - | Attribute of string * rng list (* *) - | Interleave of rng list (* *) - | ZeroOrMore of rng (* *) - | OneOrMore of rng (* *) - | Optional of rng (* *) - | Choice of string list (* * *) - | Value of string (* str *) - | Text (* *) - -let rec string_of_rng = function - | Element (name, xs) -> - "Element (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))" - | Attribute (name, xs) -> - "Attribute (\"" ^ name ^ "\", (" ^ string_of_rng_list xs ^ "))" - | Interleave xs -> "Interleave (" ^ string_of_rng_list xs ^ ")" - | ZeroOrMore rng -> "ZeroOrMore (" ^ string_of_rng rng ^ ")" - | OneOrMore rng -> "OneOrMore (" ^ string_of_rng rng ^ ")" - | Optional rng -> "Optional (" ^ string_of_rng rng ^ ")" - | Choice values -> "Choice [" ^ String.concat ", " values ^ "]" - | Value value -> "Value \"" ^ value ^ "\"" - | Text -> "Text" - -and string_of_rng_list xs = - String.concat ", " (List.map string_of_rng xs) - -let rec parse_rng ?defines context = function - | [] -> [] - | Xml.Element ("element", ["name", name], children) :: rest -> - Element (name, parse_rng ?defines context children) - :: parse_rng ?defines context rest - | Xml.Element ("attribute", ["name", name], children) :: rest -> - Attribute (name, parse_rng ?defines context children) - :: parse_rng ?defines context rest - | Xml.Element ("interleave", [], children) :: rest -> - Interleave (parse_rng ?defines context children) - :: parse_rng ?defines context rest - | Xml.Element ("zeroOrMore", [], [child]) :: rest -> - let rng = parse_rng ?defines context [child] in - (match rng with - | [child] -> ZeroOrMore child :: parse_rng ?defines context rest - | _ -> - failwithf "%s: contains more than one child element" - context - ) - | Xml.Element ("oneOrMore", [], [child]) :: rest -> - let rng = parse_rng ?defines context [child] in - (match rng with - | [child] -> OneOrMore child :: parse_rng ?defines context rest - | _ -> - failwithf "%s: contains more than one child element" - context - ) - | Xml.Element ("optional", [], [child]) :: rest -> - let rng = parse_rng ?defines context [child] in - (match rng with - | [child] -> Optional child :: parse_rng ?defines context rest - | _ -> - failwithf "%s: contains more than one child element" - context - ) - | Xml.Element ("choice", [], children) :: rest -> - let values = List.map ( - function Xml.Element ("value", [], [Xml.PCData value]) -> value - | _ -> - failwithf "%s: can't handle anything except in " - context - ) children in - Choice values - :: parse_rng ?defines context rest - | Xml.Element ("value", [], [Xml.PCData value]) :: rest -> - Value value :: parse_rng ?defines context rest - | Xml.Element ("text", [], []) :: rest -> - Text :: parse_rng ?defines context rest - | Xml.Element ("ref", ["name", name], []) :: rest -> - (* Look up the reference. Because of limitations in this parser, - * we can't handle arbitrarily nested yet. You can only - * use from inside . - *) - (match defines with - | None -> - failwithf "%s: contains , but no refs are defined yet" context - | Some map -> - let rng = StringMap.find name map in - rng @ parse_rng ?defines context rest - ) - | x :: _ -> - failwithf "%s: can't handle '%s' in schema" context (Xml.to_string x) - -let grammar = - let xml = Xml.parse_file rng_input in - match xml with - | Xml.Element ("grammar", _, - Xml.Element ("start", _, gram) :: defines) -> - (* The elements are referenced in the section, - * so build a map of those first. - *) - let defines = List.fold_left ( - fun map -> - function Xml.Element ("define", ["name", name], defn) -> - StringMap.add name defn map - | _ -> - failwithf "%s: expected " rng_input - ) StringMap.empty defines in - let defines = StringMap.mapi parse_rng defines in - - (* Parse the clause, passing the defines. *) - parse_rng ~defines "" gram - | _ -> - failwithf "%s: input is not *" - rng_input - -let name_of_field = function - | Element (name, _) | Attribute (name, _) - | ZeroOrMore (Element (name, _)) - | OneOrMore (Element (name, _)) - | Optional (Element (name, _)) -> name - | Optional (Attribute (name, _)) -> name - | Text -> (* an unnamed field in an element *) - "data" - | rng -> - failwithf "name_of_field failed at: %s" (string_of_rng rng) - -(* At the moment this function only generates OCaml types. However we - * should parameterize it later so it can generate types/structs in a - * variety of languages. - *) -let generate_types xs = - (* A simple type is one that can be printed out directly, eg. - * "string option". A complex type is one which has a name and has - * to be defined via another toplevel definition, eg. a struct. - * - * generate_type generates code for either simple or complex types. - * In the simple case, it returns the string ("string option"). In - * the complex case, it returns the name ("mountpoint"). In the - * complex case it has to print out the definition before returning, - * so it should only be called when we are at the beginning of a - * new line (BOL context). - *) - let rec generate_type = function - | Text -> (* string *) - "string", true - | Choice values -> (* [`val1|`val2|...] *) - "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true - | ZeroOrMore rng -> (* list *) - let t, is_simple = generate_type rng in - t ^ " list (* 0 or more *)", is_simple - | OneOrMore rng -> (* list *) - let t, is_simple = generate_type rng in - t ^ " list (* 1 or more *)", is_simple - (* virt-inspector hack: bool *) - | Optional (Attribute (name, [Value "1"])) -> - "bool", true - | Optional rng -> (* list *) - let t, is_simple = generate_type rng in - t ^ " option", is_simple - (* type name = { fields ... } *) - | Element (name, fields) when is_attrs_interleave fields -> - generate_type_struct name (get_attrs_interleave fields) - | Element (name, [field]) (* type name = field *) - | Attribute (name, [field]) -> - let t, is_simple = generate_type field in - if is_simple then (t, true) - else ( - pr "type %s = %s\n" name t; - name, false - ) - | Element (name, fields) -> (* type name = { fields ... } *) - generate_type_struct name fields - | rng -> - failwithf "generate_type failed at: %s" (string_of_rng rng) - - and is_attrs_interleave = function - | [Interleave _] -> true - | Attribute _ :: fields -> is_attrs_interleave fields - | Optional (Attribute _) :: fields -> is_attrs_interleave fields - | _ -> false - - and get_attrs_interleave = function - | [Interleave fields] -> fields - | ((Attribute _) as field) :: fields - | ((Optional (Attribute _)) as field) :: fields -> - field :: get_attrs_interleave fields - | _ -> assert false - - and generate_types xs = - List.iter (fun x -> ignore (generate_type x)) xs - - and generate_type_struct name fields = - (* Calculate the types of the fields first. We have to do this - * before printing anything so we are still in BOL context. - *) - let types = List.map fst (List.map generate_type fields) in - - (* Special case of a struct containing just a string and another - * field. Turn it into an assoc list. - *) - match types with - | ["string"; other] -> - let fname1, fname2 = - match fields with - | [f1; f2] -> name_of_field f1, name_of_field f2 - | _ -> assert false in - pr "type %s = string * %s (* %s -> %s *)\n" name other fname1 fname2; - name, false - - | types -> - pr "type %s = {\n" name; - List.iter ( - fun (field, ftype) -> - let fname = name_of_field field in - pr " %s_%s : %s;\n" name fname ftype - ) (List.combine fields types); - pr "}\n"; - (* Return the name of this type, and - * false because it's not a simple type. - *) - name, false - in - - generate_types xs - -let generate_parsers xs = - (* As for generate_type above, generate_parser makes a parser for - * some type, and returns the name of the parser it has generated. - * Because it (may) need to print something, it should always be - * called in BOL context. - *) - let rec generate_parser = function - | Text -> (* string *) - "string_child_or_empty" - | Choice values -> (* [`val1|`val2|...] *) - sprintf "(fun x -> match Xml.pcdata (first_child x) with %s | str -> failwith (\"unexpected field value: \" ^ str))" - (String.concat "|" - (List.map (fun v -> sprintf "%S -> `%s" v v) values)) - | ZeroOrMore rng -> (* list *) - let pa = generate_parser rng in - sprintf "(fun x -> List.map %s (Xml.children x))" pa - | OneOrMore rng -> (* list *) - let pa = generate_parser rng in - sprintf "(fun x -> List.map %s (Xml.children x))" pa - (* virt-inspector hack: bool *) - | Optional (Attribute (name, [Value "1"])) -> - sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name - | Optional rng -> (* list *) - let pa = generate_parser rng in - sprintf "(function None -> None | Some x -> Some (%s x))" pa - (* type name = { fields ... } *) - | Element (name, fields) when is_attrs_interleave fields -> - generate_parser_struct name (get_attrs_interleave fields) - | Element (name, [field]) -> (* type name = field *) - let pa = generate_parser field in - let parser_name = sprintf "parse_%s_%d" name (unique ()) in - pr "let %s =\n" parser_name; - pr " %s\n" pa; - pr "let parse_%s = %s\n" name parser_name; - parser_name - | Attribute (name, [field]) -> - let pa = generate_parser field in - let parser_name = sprintf "parse_%s_%d" name (unique ()) in - pr "let %s =\n" parser_name; - pr " %s\n" pa; - pr "let parse_%s = %s\n" name parser_name; - parser_name - | Element (name, fields) -> (* type name = { fields ... } *) - generate_parser_struct name ([], fields) - | rng -> - failwithf "generate_parser failed at: %s" (string_of_rng rng) - - and is_attrs_interleave = function - | [Interleave _] -> true - | Attribute _ :: fields -> is_attrs_interleave fields - | Optional (Attribute _) :: fields -> is_attrs_interleave fields - | _ -> false - - and get_attrs_interleave = function - | [Interleave fields] -> [], fields - | ((Attribute _) as field) :: fields - | ((Optional (Attribute _)) as field) :: fields -> - let attrs, interleaves = get_attrs_interleave fields in - (field :: attrs), interleaves - | _ -> assert false - - and generate_parsers xs = - List.iter (fun x -> ignore (generate_parser x)) xs - - and generate_parser_struct name (attrs, interleaves) = - (* Generate parsers for the fields first. We have to do this - * before printing anything so we are still in BOL context. - *) - let fields = attrs @ interleaves in - let pas = List.map generate_parser fields in - - (* Generate an intermediate tuple from all the fields first. - * If the type is just a string + another field, then we will - * return this directly, otherwise it is turned into a record. - * - * RELAX NG note: This code treats and plain lists of - * fields the same. In other words, it doesn't bother enforcing - * any ordering of fields in the XML. - *) - pr "let parse_%s x =\n" name; - pr " let t = (\n "; - let comma = ref false in - List.iter ( - fun x -> - if !comma then pr ",\n "; - comma := true; - match x with - | Optional (Attribute (fname, [field])), pa -> - pr "%s x" pa - | Optional (Element (fname, [field])), pa -> - pr "%s (optional_child %S x)" pa fname - | Attribute (fname, [Text]), _ -> - pr "attribute %S x" fname - | (ZeroOrMore _ | OneOrMore _), pa -> - pr "%s x" pa - | Text, pa -> - pr "%s x" pa - | (field, pa) -> - let fname = name_of_field field in - pr "%s (child %S x)" pa fname - ) (List.combine fields pas); - pr "\n ) in\n"; - - (match fields with - | [Element (_, [Text]) | Attribute (_, [Text]); _] -> - pr " t\n" - - | _ -> - pr " (Obj.magic t : %s)\n" name -(* - List.iter ( - function - | (Optional (Attribute (fname, [field])), pa) -> - pr " %s_%s =\n" name fname; - pr " %s x;\n" pa - | (Optional (Element (fname, [field])), pa) -> - pr " %s_%s =\n" name fname; - pr " (let x = optional_child %S x in\n" fname; - pr " %s x);\n" pa - | (field, pa) -> - let fname = name_of_field field in - pr " %s_%s =\n" name fname; - pr " (let x = child %S x in\n" fname; - pr " %s x);\n" pa - ) (List.combine fields pas); - pr "}\n" -*) - ); - sprintf "parse_%s" name - in - - generate_parsers xs - -(* Generate ocaml/guestfs_inspector.mli. *) -let generate_ocaml_inspector_mli () = - generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus; - - pr "\ -(** This is an OCaml language binding to the external [virt-inspector] - program. - - For more information, please read the man page [virt-inspector(1)]. -*) - -"; - - generate_types grammar; - pr "(** The nested information returned from the {!inspect} function. *)\n"; - pr "\n"; - - pr "\ -val inspect : ?connect:string -> ?xml:string -> string list -> operatingsystems -(** To inspect a libvirt domain called [name], pass a singleton - list: [inspect [name]]. When using libvirt only, you may - optionally pass a libvirt URI using [inspect ~connect:uri ...]. - - To inspect a disk image or images, pass a list of the filenames - of the disk images: [inspect filenames] - - This function inspects the given guest or disk images and - returns a list of operating system(s) found and a large amount - of information about them. In the vast majority of cases, - a virtual machine only contains a single operating system. - - If the optional [~xml] parameter is given, then this function - skips running the external virt-inspector program and just - parses the given XML directly (which is expected to be XML - produced from a previous run of virt-inspector). The list of - names and connect URI are ignored in this case. - - This function can throw a wide variety of exceptions, for example - if the external virt-inspector program cannot be found, or if - it doesn't generate valid XML. -*) -" - -(* Generate ocaml/guestfs_inspector.ml. *) -let generate_ocaml_inspector_ml () = - generate_header ~extra_inputs:[rng_input] OCamlStyle LGPLv2plus; - - pr "open Unix\n"; - pr "\n"; - - generate_types grammar; - pr "\n"; - - pr "\ -(* Misc functions which are used by the parser code below. *) -let first_child = function - | Xml.Element (_, _, c::_) -> c - | Xml.Element (name, _, []) -> - failwith (\"expected <\" ^ name ^ \"/> to have a child node\") - | Xml.PCData str -> - failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\") - -let string_child_or_empty = function - | Xml.Element (_, _, [Xml.PCData s]) -> s - | Xml.Element (_, _, []) -> \"\" - | Xml.Element (x, _, _) -> - failwith (\"expected XML tag with a single PCDATA child, but got \" ^ - x ^ \" instead\") - | Xml.PCData str -> - failwith (\"expected XML tag, but read PCDATA '\" ^ str ^ \"' instead\") - -let optional_child name xml = - let children = Xml.children xml in - try - Some (List.find (function - | Xml.Element (n, _, _) when n = name -> true - | _ -> false) children) - with - Not_found -> None - -let child name xml = - match optional_child name xml with - | Some c -> c - | None -> - failwith (\"mandatory field <\" ^ name ^ \"/> missing in XML output\") - -let attribute name xml = - try Xml.attrib xml name - with Xml.No_attribute _ -> - failwith (\"mandatory attribute \" ^ name ^ \" missing in XML output\") - -"; - - generate_parsers grammar; - pr "\n"; - - pr "\ -(* Run external virt-inspector, then use parser to parse the XML. *) -let inspect ?connect ?xml names = - let xml = - match xml with - | None -> - if names = [] then invalid_arg \"inspect: no names given\"; - let cmd = [ \"virt-inspector\"; \"--xml\" ] @ - (match connect with None -> [] | Some uri -> [ \"--connect\"; uri ]) @ - names in - let cmd = List.map Filename.quote cmd in - let cmd = String.concat \" \" cmd in - let chan = open_process_in cmd in - let xml = Xml.parse_in chan in - (match close_process_in chan with - | WEXITED 0 -> () - | WEXITED _ -> failwith \"external virt-inspector command failed\" - | WSIGNALED i | WSTOPPED i -> - failwith (\"external virt-inspector command died or stopped on sig \" ^ - string_of_int i) - ); - xml - | Some doc -> - Xml.parse_string doc in - parse_operatingsystems xml -" - and generate_max_proc_nr () = pr "%d\n" max_proc_nr @@ -12762,8 +12274,6 @@ Run it from the top source directory using the command 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;