1 (* 'top'-like tool for libvirt domains.
2 * $Id: virt_top_xml.ml,v 1.1 2007/08/23 09:36:04 rjones Exp $
4 * This file contains all code which requires xml-light.
9 module C = Libvirt.Connect
10 module D = Libvirt.Domain
11 module N = Libvirt.Network ;;
13 Virt_top.parse_device_xml :=
16 let xml = D.get_xml_desc dom in
17 let xml = Xml.parse_string xml in
20 | Xml.Element ("domain", _, children) ->
24 | Xml.Element ("devices", _, devices) -> Some devices
29 failwith "get_xml_desc didn't return <domain/>" in
30 let rec target_dev_of = function
32 | Xml.Element ("target", attrs, _) :: rest ->
33 (try Some (List.assoc "dev" attrs)
34 with Not_found -> target_dev_of rest)
35 | _ :: rest -> target_dev_of rest
40 | Xml.Element ("disk", _, children) -> target_dev_of children
46 | Xml.Element ("interface", _, children) -> target_dev_of children
52 | Libvirt.Virterror _ -> [], [] (* ignore transient errs *)