"uri " ^ s_ "Connect to URI (default: Xen)";
"--connect", Arg.String set_uri,
"uri " ^ s_ "Connect to URI (default: Xen)";
+ "--debug", Arg.Set debug,
+ " " ^ s_ "Debug mode (default: false)";
"-h", Arg.Set human,
" " ^ s_ "Print sizes in human-readable format";
"--human-readable", Arg.Set human,
"--inodes", Arg.Set inodes,
" " ^ s_ "Show inodes instead of blocks";
"-t", Arg.String test_mode,
- "dev" ^ s_ "(Test mode) Display contents of block device or file";
+ "dev " ^ s_ "(Test mode) Display contents of block device or file";
"--version", Arg.Unit version,
" " ^ s_ "Display version and exit";
] in
| _ -> None
) devices in
- { dom_name = name; dom_id = domid; dom_disks = disks }
+ { dom_name = name; dom_id = domid;
+ dom_disks = disks; dom_lv_filesystems = [] }
) xmls
) else (
(* In test mode (-t option) the user can pass one or more
d_source = filename; d_target = "hda";
d_dev = new block_device filename; d_content = `Unknown;
}
- ]
+ ];
+ dom_lv_filesystems = []
}
) !test_files
) in
{ disk with d_content = `Partitions parts }
| None ->
(* Not partitioned. Does it contain a filesystem? *)
- let fs = probe_for_filesystems dev in
+ let fs = probe_for_filesystem dev in
match fs with
| Some fs ->
{ disk with d_content = `Filesystem fs }
| None ->
- (* Not partitioned, no filesystem, so it's spare. *)
- disk
+ (* Not partitioned, no filesystem, is it a PV? *)
+ let pv = probe_for_pv dev in
+ match pv with
+ | Some lvm_name ->
+ { disk with d_content = `PhysicalVolume lvm_name }
+ | None ->
+ disk (* Spare/unknown. *)
) in
(* Now we have either detected partitions or a filesystem on each
let ps = List.map (
fun p ->
if p.part_status = Bootable || p.part_status = Nonbootable then (
- let fs = probe_for_filesystems p.part_dev in
+ let fs = probe_for_filesystem p.part_dev in
match fs with
| Some fs ->
{ p with part_content = `Filesystem fs }
| None ->
- p
+ (* Is it a PV? *)
+ let pv = probe_for_pv p.part_dev in
+ match pv with
+ | Some lvm_name ->
+ { p with part_content = `PhysicalVolume lvm_name }
+ | None ->
+ p (* Spare/unknown. *)
) else p
) parts.parts in
let parts = { parts with parts = ps } in
| disk -> disk
) in
- (* XXX LVM stuff here. *)
-
-
-
- (* Print the title. *)
+ (* LVM filesystem detection
+ *
+ * For each domain, look for all disks/partitions which have been
+ * identified as PVs and pass those back to the respective LVM
+ * plugin for LV detection.
+ *
+ * (Note - a two-stage process because an LV can be spread over
+ * several PVs, so we have to detect all PVs belonging to a
+ * domain first).
+ *
+ * XXX To deal with RAID (ie. md devices) we will need to loop
+ * around here because RAID is like LVM except that they normally
+ * present as block devices which can be used by LVM.
+ *)
+ (* First: LV detection. *)
+ let doms = List.map (
+ fun ({ dom_disks = disks } as dom) ->
+ (* Find all physical volumes, can be disks or partitions. *)
+ let pvs_on_disks = List.filter_map (
+ function
+ | { d_dev = d_dev;
+ d_content = `PhysicalVolume pv } -> Some (pv, d_dev)
+ | _ -> None
+ ) disks in
+ let pvs_on_partitions = List.map (
+ function
+ | { d_content = `Partitions { parts = parts } } ->
+ List.filter_map (
+ function
+ | { part_dev = part_dev;
+ part_content = `PhysicalVolume pv } ->
+ Some (pv, part_dev)
+ | _ -> None
+ ) parts
+ | _ -> []
+ ) disks in
+ let lvs = List.concat (pvs_on_disks :: pvs_on_partitions) in
+ dom, lvs
+ ) doms in
+
+ (* Second: filesystem on LV detection. *)
+ let doms = List.map (
+ fun (dom, lvs) ->
+ (* Group the LVs by plug-in type. *)
+ let cmp (a,_) (b,_) = compare a b in
+ let lvs = List.sort ~cmp lvs in
+ let lvs = group_by lvs in
+
+ let lvs =
+ List.map (fun (pv, devs) -> list_lvs pv.lvm_plugin_id devs) lvs in
+ let lvs = List.concat lvs in
+
+ (* lvs is a list of potential LV devices. Now run them through the
+ * probes to see if any contain filesystems.
+ *)
+ let filesystems =
+ List.filter_map (
+ fun ({ lv_dev = dev } as lv) ->
+ match probe_for_filesystem dev with
+ | Some fs -> Some (lv, fs)
+ | None -> None
+ ) lvs in
+
+ { dom with dom_lv_filesystems = filesystems }
+ ) doms in
+
+ (* Now print the results.
+ *
+ * Print the title.
+ *)
let () =
let total, used, avail =
match !inodes, !human with
in
(* HOF to iterate over filesystems. *)
- let iter_over_filesystems doms f =
+ let iter_over_filesystems doms
+ (f : domain -> ?disk:disk -> ?partno:int -> device -> filesystem ->
+ unit) =
List.iter (
- fun ({ dom_disks = disks } as dom) ->
+ fun ({ dom_disks = disks; dom_lv_filesystems = filesystems } as dom) ->
+ (* Ordinary filesystems found on disks & partitions. *)
List.iter (
function
- | ({ d_content = `Filesystem fs } as disk) ->
- f dom disk None fs
+ | ({ d_content = `Filesystem fs; d_dev = dev } as disk) ->
+ f dom ~disk dev fs
| ({ d_content = `Partitions partitions } as disk) ->
List.iteri (
fun i ->
function
- | ({ part_content = `Filesystem fs } as part) ->
- f dom disk (Some (part, i)) fs
+ | { part_content = `Filesystem fs; part_dev = dev } ->
+ f dom ~disk ~partno:(i+1) dev fs
| _ -> ()
) partitions.parts
| _ -> ()
- ) disks
+ ) disks;
+ (* LV filesystems. *)
+ List.iter (fun ({lv_dev = dev}, fs) -> f dom dev fs) filesystems
) doms
in
(* Print stats for each recognized filesystem. *)
- let print_stats dom disk part fs =
+ let print_stats dom ?disk ?partno dev fs =
(* Printable name is like "domain:hda" or "domain:hda1". *)
let name =
let dom_name = dom.dom_name in
- let d_target = disk.d_target in
- match part with
+ (* Get the disk name (eg. "hda") from the domain XML, if
+ * we have it, otherwise use the device name (eg. for LVM).
+ *)
+ let disk_name =
+ match disk with
+ | None -> dev#name
+ | Some disk -> disk.d_target
+ in
+ match partno with
| None ->
- dom_name ^ ":" ^ d_target
- | Some (_, pnum) ->
- dom_name ^ ":" ^ d_target ^ string_of_int pnum in
+ dom_name ^ ":" ^ disk_name
+ | Some partno ->
+ dom_name ^ ":" ^ disk_name ^ string_of_int partno in
printf "%-20s " name;
if fs.fs_is_swap then (
git.annexia.org / virt-top.git / blobdiff