diff options
Diffstat (limited to 'inspector')
| -rw-r--r-- | inspector/inspector_generator.ml | 286 | ||||
| -rwxr-xr-x | inspector/virt-inspector | 34 | ||||
| -rw-r--r-- | inspector/virt-inspector.rng | 170 |
3 files changed, 245 insertions, 245 deletions
diff --git a/inspector/inspector_generator.ml b/inspector/inspector_generator.ml index a1d1aa5b..20d2b01b 100644 --- a/inspector/inspector_generator.ml +++ b/inspector/inspector_generator.ml @@ -59,15 +59,15 @@ let input = "inspector/virt-inspector.rng" * able to parse the specific input file. *) type rng = - | Element of string * rng list (* <element name=name/> *) - | Attribute of string * rng list (* <attribute name=name/> *) - | Interleave of rng list (* <interleave/> *) - | ZeroOrMore of rng (* <zeroOrMore/> *) - | OneOrMore of rng (* <oneOrMore/> *) - | Optional of rng (* <optional/> *) - | Choice of string list (* <choice><value/>*</choice> *) - | Value of string (* <value>str</value> *) - | Text (* <text/> *) + | Element of string * rng list (* <element name=name/> *) + | Attribute of string * rng list (* <attribute name=name/> *) + | Interleave of rng list (* <interleave/> *) + | ZeroOrMore of rng (* <zeroOrMore/> *) + | OneOrMore of rng (* <oneOrMore/> *) + | Optional of rng (* <optional/> *) + | Choice of string list (* <choice><value/>*</choice> *) + | Value of string (* <value>str</value> *) + | Text (* <text/> *) let rec string_of_rng = function | Element (name, xs) -> @@ -101,31 +101,31 @@ let rec parse_rng ?defines context = function (match rng with | [child] -> ZeroOrMore child :: parse_rng ?defines context rest | _ -> - failwithf "%s: <zeroOrMore> contains more than one child element" - context + failwithf "%s: <zeroOrMore> 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: <oneOrMore> contains more than one child element" - context + failwithf "%s: <oneOrMore> 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: <optional> contains more than one child element" - context + failwithf "%s: <optional> 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 <value> in <choice>" - context + function Xml.Element ("value", [], [Xml.PCData value]) -> value + | _ -> + failwithf "%s: can't handle anything except <value> in <choice>" + context ) children in Choice values :: parse_rng ?defines context rest @@ -140,10 +140,10 @@ let rec parse_rng ?defines context = function *) (match defines with | None -> - failwithf "%s: contains <ref>, but no refs are defined yet" context + failwithf "%s: contains <ref>, but no refs are defined yet" context | Some map -> - let rng = StringMap.find name map in - rng @ parse_rng ?defines context rest + 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) @@ -152,16 +152,16 @@ let grammar = let xml = Xml.parse_file input in match xml with | Xml.Element ("grammar", _, - Xml.Element ("start", _, gram) :: defines) -> + Xml.Element ("start", _, gram) :: defines) -> (* The <define/> elements are referenced in the <start> 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 <define name=name/>" input + fun map -> + function Xml.Element ("define", ["name", name], defn) -> + StringMap.add name defn map + | _ -> + failwithf "%s: expected <define name=name/>" input ) StringMap.empty defines in let defines = StringMap.mapi parse_rng defines in @@ -258,37 +258,37 @@ let generate_types xs = * 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 -> (* <rng> list *) - let t, is_simple = generate_type rng in - t ^ " list (* 0 or more *)", is_simple - | OneOrMore rng -> (* <rng> list *) - let t, is_simple = generate_type rng in - t ^ " list (* 1 or more *)", is_simple - (* virt-inspector hack: bool *) + | Text -> (* string *) + "string", true + | Choice values -> (* [`val1|`val2|...] *) + "[" ^ String.concat "|" (List.map ((^)"`") values) ^ "]", true + | ZeroOrMore rng -> (* <rng> list *) + let t, is_simple = generate_type rng in + t ^ " list (* 0 or more *)", is_simple + | OneOrMore rng -> (* <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 -> (* <rng> list *) - let t, is_simple = generate_type rng in - t ^ " option", is_simple + "bool", true + | Optional rng -> (* <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 *) + 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 + 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) + failwithf "generate_type failed at: %s" (string_of_rng rng) and is_attrs_interleave = function | [Interleave _] -> true @@ -300,7 +300,7 @@ let generate_types xs = | [Interleave fields] -> fields | ((Attribute _) as field) :: fields | ((Optional (Attribute _)) as field) :: fields -> - field :: get_attrs_interleave fields + field :: get_attrs_interleave fields | _ -> assert false and generate_types xs = @@ -317,25 +317,25 @@ let generate_types xs = *) 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 + 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 + 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 @@ -347,45 +347,45 @@ let generate_parsers xs = * 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 -> (* <rng> list *) - let pa = generate_parser rng in - sprintf "(fun x -> List.map %s (Xml.children x))" pa - | OneOrMore rng -> (* <rng> list *) - let pa = generate_parser rng in - sprintf "(fun x -> List.map %s (Xml.children x))" pa - (* virt-inspector hack: bool *) + | 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 -> (* <rng> list *) + let pa = generate_parser rng in + sprintf "(fun x -> List.map %s (Xml.children x))" pa + | OneOrMore rng -> (* <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 -> (* <rng> list *) - let pa = generate_parser rng in - sprintf "(function None -> None | Some x -> Some (%s x))" pa + sprintf "(fun x -> try ignore (Xml.attrib x %S); true with Xml.No_attribute _ -> false)" name + | Optional rng -> (* <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 + 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) + 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) + failwithf "generate_parser failed at: %s" (string_of_rng rng) and is_attrs_interleave = function | [Interleave _] -> true @@ -397,8 +397,8 @@ let generate_parsers xs = | [Interleave fields] -> [], fields | ((Attribute _) as field) :: fields | ((Optional (Attribute _)) as field) :: fields -> - let attrs, interleaves = get_attrs_interleave fields in - (field :: attrs), interleaves + let attrs, interleaves = get_attrs_interleave fields in + (field :: attrs), interleaves | _ -> assert false and generate_parsers xs = @@ -424,48 +424,48 @@ let generate_parsers xs = 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 + 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 " t\n" | _ -> - pr " (Obj.magic t : %s)\n" name + 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" + 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 @@ -612,7 +612,7 @@ let output_to filename = (* Is the new file different from the current file? *) if Sys.file_exists filename && files_equal filename filename_new then - Unix.unlink filename_new (* same, so skip it *) + Unix.unlink filename_new (* same, so skip it *) else ( (* different, overwrite old one *) (try Unix.chmod filename 0o644 with Unix.Unix_error _ -> ()); diff --git a/inspector/virt-inspector b/inspector/virt-inspector index 13673aff..071f0b08 100755 --- a/inspector/virt-inspector +++ b/inspector/virt-inspector @@ -550,23 +550,23 @@ sub output_xml_os } if ($os->{kernels}) { - $xml->startTag("kernels"); - my @kernels = @{$os->{kernels}}; - foreach (@kernels) { - $xml->startTag("kernel", - "version" => $_->{version}, - "arch" => $_->{arch}); - $xml->startTag("modules"); - my @modules = @{$_->{modules}}; - foreach (@modules) { - $xml->dataElement("module", $_); - } - $xml->endTag("modules"); - $xml->dataElement("path", $_->{path}) if(defined($_->{path})); - $xml->dataElement("package", $_->{package}) if(defined($_->{package})); - $xml->endTag("kernel"); - } - $xml->endTag("kernels"); + $xml->startTag("kernels"); + my @kernels = @{$os->{kernels}}; + foreach (@kernels) { + $xml->startTag("kernel", + "version" => $_->{version}, + "arch" => $_->{arch}); + $xml->startTag("modules"); + my @modules = @{$_->{modules}}; + foreach (@modules) { + $xml->dataElement("module", $_); + } + $xml->endTag("modules"); + $xml->dataElement("path", $_->{path}) if(defined($_->{path})); + $xml->dataElement("package", $_->{package}) if(defined($_->{package})); + $xml->endTag("kernel"); + } + $xml->endTag("kernels"); } if (exists $os->{root}->{registry}) { diff --git a/inspector/virt-inspector.rng b/inspector/virt-inspector.rng index 1da58fc8..c8f6075e 100644 --- a/inspector/virt-inspector.rng +++ b/inspector/virt-inspector.rng @@ -20,36 +20,36 @@ <start> <element name="operatingsystems"> <oneOrMore> - <element name="operatingsystem"> - <interleave> - - <!-- required fields for an operating system --> - <element name="name"> - <choice> - <value>linux</value> - <value>windows</value> - </choice> - </element> - <element name="arch"><text/></element> - <element name="root"><text/></element> - - <!-- optional fields for an operating system --> - <optional><element name="distro"><text/></element></optional> - <optional><element name="major_version"><text/></element></optional> - <optional><element name="minor_version"><text/></element></optional> - <optional><element name="package_format"><text/></element></optional> - <optional><element name="package_management"><text/></element></optional> - - <ref name="mountpoints"/> - <ref name="filesystems"/> - <optional><ref name="applications"/></optional> - <optional><ref name="modprobealiases"/></optional> - <optional><ref name="initrds"/></optional> - <optional><ref name="kernels"/></optional> - <optional><ref name="boot"/></optional> - - </interleave> - </element> + <element name="operatingsystem"> + <interleave> + + <!-- required fields for an operating system --> + <element name="name"> + <choice> + <value>linux</value> + <value>windows</value> + </choice> + </element> + <element name="arch"><text/></element> + <element name="root"><text/></element> + + <!-- optional fields for an operating system --> + <optional><element name="distro"><text/></element></optional> + <optional><element name="major_version"><text/></element></optional> + <optional><element name="minor_version"><text/></element></optional> + <optional><element name="package_format"><text/></element></optional> + <optional><element name="package_management"><text/></element></optional> + + <ref name="mountpoints"/> + <ref name="filesystems"/> + <optional><ref name="applications"/></optional> + <optional><ref name="modprobealiases"/></optional> + <optional><ref name="initrds"/></optional> + <optional><ref name="kernels"/></optional> + <optional><ref name="boot"/></optional> + + </interleave> + </element> </oneOrMore> </element> </start> @@ -58,10 +58,10 @@ <define name="mountpoints"> <element name="mountpoints"> <oneOrMore> - <element name="mountpoint"> - <attribute name="dev"><text/></attribute> - <text/> - </element> + <element name="mountpoint"> + <attribute name="dev"><text/></attribute> + <text/> + </element> </oneOrMore> </element> </define> @@ -70,16 +70,16 @@ <define name="filesystems"> <element name="filesystems"> <oneOrMore> - <element name="filesystem"> - <attribute name="dev"><text/></attribute> - <interleave> - <element name="type"><text/></element> - <optional><element name="content"><text/></element></optional> - <optional><element name="label"><text/></element></optional> - <optional><element name="uuid"><text/></element></optional> - <optional><element name="spec"><text/></element></optional> - </interleave> - </element> + <element name="filesystem"> + <attribute name="dev"><text/></attribute> + <interleave> + <element name="type"><text/></element> + <optional><element name="content"><text/></element></optional> + <optional><element name="label"><text/></element></optional> + <optional><element name="uuid"><text/></element></optional> + <optional><element name="spec"><text/></element></optional> + </interleave> + </element> </oneOrMore> </element> </define> @@ -88,10 +88,10 @@ <define name="applications"> <element name="applications"> <zeroOrMore> - <element name="application"> - <element name="name"><text/></element> - <element name="version"><text/></element> - </element> + <element name="application"> + <element name="name"><text/></element> + <element name="version"><text/></element> + </element> </zeroOrMore> </element> </define> @@ -100,14 +100,14 @@ <define name="modprobealiases"> <element name="modprobealiases"> <zeroOrMore> - <element name="alias"> - <attribute name="device"><text/></attribute> - <interleave> - <element name="modulename"><text/></element> - <optional><element name="augeas"><text/></element></optional> - <element name="file"><text/></element> - </interleave> - </element> + <element name="alias"> + <attribute name="device"><text/></attribute> + <interleave> + <element name="modulename"><text/></element> + <optional><element name="augeas"><text/></element></optional> + <element name="file"><text/></element> + </interleave> + </element> </zeroOrMore> </element> </define> @@ -116,12 +116,12 @@ <define name="initrds"> <element name="initrds"> <zeroOrMore> - <element name="initrd"> - <attribute name="version"><text/></attribute> - <zeroOrMore> - <element name="module"><text/></element> - </zeroOrMore> - </element> + <element name="initrd"> + <attribute name="version"><text/></attribute> + <zeroOrMore> + <element name="module"><text/></element> + </zeroOrMore> + </element> </zeroOrMore> </element> </define> @@ -130,16 +130,16 @@ <define name="boot"> <element name="boot"> <zeroOrMore> - <element name="config"> - <optional> - <attribute name="default"><value>1</value></attribute> - </optional> - <interleave> - <element name="title"><text/></element> - <element name="kernel"><text/></element> - <element name="cmdline"><text/></element> - </interleave> - </element> + <element name="config"> + <optional> + <attribute name="default"><value>1</value></attribute> + </optional> + <interleave> + <element name="title"><text/></element> + <element name="kernel"><text/></element> + <element name="cmdline"><text/></element> + </interleave> + </element> </zeroOrMore> </element> </define> @@ -148,19 +148,19 @@ <define name="kernels"> <element name="kernels"> <zeroOrMore> - <element name="kernel"> - <attribute name="version"><text/></attribute> - <attribute name="arch"><text/></attribute> - <interleave> - <element name="modules"> - <zeroOrMore> - <element name="module"><text/></element> - </zeroOrMore> - </element> - <optional><element name="path"><text/></element></optional> - <optional><element name="package"><text/></element></optional> - </interleave> - </element> + <element name="kernel"> + <attribute name="version"><text/></attribute> + <attribute name="arch"><text/></attribute> + <interleave> + <element name="modules"> + <zeroOrMore> + <element name="module"><text/></element> + </zeroOrMore> + </element> + <optional><element name="path"><text/></element></optional> + <optional><element name="package"><text/></element></optional> + </interleave> + </element> </zeroOrMore> </element> </define> |