open Virt_df_gettext.Gettext
open Virt_df
+let ( +* ) = Int32.add
+let ( -* ) = Int32.sub
+let ( ** ) = Int32.mul
+let ( /* ) = Int32.div
+
+let ( +^ ) = Int64.add
+let ( -^ ) = Int64.sub
+let ( *^ ) = Int64.mul
+let ( /^ ) = Int64.div
+
let () =
(* Command line argument parsing. *)
let set_uri = function "" -> uri := None | u -> uri := Some u in
"uri " ^ s_ "Connect to URI (default: Xen)";
"--csv", Arg.Set csv_mode,
" " ^ s_ "Write results in CSV format";
- "--debug", Arg.Set debug,
+ "--debug", Arg.Set Diskimage.debug,
" " ^ s_ "Debug mode (default: false)";
"-h", Arg.Set human,
" " ^ s_ "Print sizes in human-readable format";
csv_write stdout
in
- let doms : domain list =
+ (* name target dev_path *)
+ let doms : (string * (string * string) list) list =
if !test_files = [] then (
let xmls =
(* Connect to the hypervisor. *)
| Xml.Element ("domain", attrs, children) -> children, attrs
| _ -> failwith (s_ "get_xml_desc didn't return <domain/>") in
- let domid =
+ (*let domid =
try Some (int_of_string (List.assoc "id" domain_attrs))
- with Not_found -> None in
+ with Not_found -> None in*)
let rec loop = function
| [] ->
List.filter_map (
function
| Xml.Element ("disk", attrs, children) ->
- let typ =
+ (*let typ =
try Some (List.assoc "type" attrs)
- with Not_found -> None in
+ with Not_found -> None in*)
let device =
try Some (List.assoc "device" attrs)
with Not_found -> None in
* source and target. Ignore CD-ROM devices.
*)
(match source, target, device with
- | _, _, Some "cdrom" -> None (* ignore *)
- | Some source, Some target, Some device ->
- (* Try to create a 'device' object for this
- * device. If it fails, print a warning
- * and ignore the device.
- *)
- (try
- let dev = new block_device source in
- Some {
- d_type = typ; d_device = device;
- d_source = source; d_target = target;
- d_dev = dev; d_content = `Unknown
- }
- with
- Unix.Unix_error (err, func, param) ->
- eprintf "%s:%s: %s" func param
- (Unix.error_message err);
- None
- )
+ | _, _, Some "cdrom" -> None (* ignore CD-ROMs *)
+ | Some source, Some target, _ -> Some (target, source)
| _ -> None (* ignore anything else *)
)
| _ -> None
) devices in
- { dom_name = name; dom_id = domid;
- dom_disks = disks; dom_lv_filesystems = [] }
+ name, disks
) xmls
) else (
(* In test mode (-t option) the user can pass one or more
*)
List.map (
fun filename ->
- {
- dom_name = filename; dom_id = None;
- dom_disks = [
- {
- d_type = Some "disk"; d_device = "disk";
- d_source = filename; d_target = "hda";
- d_dev = new block_device filename; d_content = `Unknown;
- }
- ];
- dom_lv_filesystems = []
- }
+ filename, ["hda", filename]
) !test_files
) in
- (* HOF to map over disks. *)
- let map_over_disks doms f =
- List.map (
- fun ({ dom_disks = disks } as dom) ->
- let disks = List.map f disks in
- { dom with dom_disks = disks }
- ) doms
- in
-
- (* 'doms' is our list of domains and their guest block devices, and
- * we've successfully opened each block device. Now probe them
- * to find out what they contain.
- *)
- let doms = map_over_disks doms (
- fun ({ d_dev = dev } as disk) ->
- (* See if it is partitioned first. *)
- let parts = probe_for_partitions dev in
- match parts with
- | Some parts ->
- { disk with d_content = `Partitions parts }
- | None ->
- (* Not partitioned. Does it contain a filesystem? *)
- let fs = probe_for_filesystem dev in
- match fs with
- | Some fs ->
- { disk with d_content = `Filesystem fs }
- | None ->
- (* 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
- * physical device (or perhaps neither). See what is on those
- * partitions.
- *)
- let doms = map_over_disks doms (
- function
- | ({ d_dev = dev; d_content = `Partitions parts } as disk) ->
- let ps = List.map (
- fun p ->
- if p.part_status = Bootable || p.part_status = Nonbootable then (
- let fs = probe_for_filesystem p.part_dev in
- match fs with
- | Some fs ->
- { p with part_content = `Filesystem fs }
- | None ->
- (* 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 with d_content = `Partitions parts }
- | disk -> disk
- ) in
-
- (* 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
+ (* Convert these to Diskimage library 'machine's. *)
+ let machines = List.filter_map (
+ fun (name, disks) ->
+ try Some (Diskimage.open_machine name disks)
+ with Unix.Unix_error (err, func, param) ->
+ eprintf "%s:%s: %s" func param (Unix.error_message err);
+ None
) 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
+ (* Scan them. *)
+ let machines = List.map Diskimage.scan_machine machines in
(*----------------------------------------------------------------------*)
(* Now print the results. *)
in
(* HOF to iterate over filesystems. *)
- let iter_over_filesystems doms
- (f : domain -> ?disk:disk -> ?partno:int -> device -> filesystem ->
+ let iter_over_filesystems machines
+ (f : Diskimage.machine -> ?disk:Diskimage.disk -> ?partno:int ->
+ Diskimage.device -> Diskimage.filesystem ->
unit) =
List.iter (
- fun ({ dom_disks = disks; dom_lv_filesystems = filesystems } as dom) ->
+ fun ({ Diskimage.m_disks = disks;
+ m_lv_filesystems = filesystems } as dom) ->
(* Ordinary filesystems found on disks & partitions. *)
List.iter (
function
- | ({ d_content = `Filesystem fs; d_dev = dev } as disk) ->
+ | ({ Diskimage.d_content = `Filesystem fs; d_dev = dev } as disk) ->
f dom ~disk dev fs
- | ({ d_content = `Partitions partitions } as disk) ->
+ | ({ Diskimage.d_content = `Partitions partitions } as disk) ->
List.iteri (
fun i ->
function
- | { part_content = `Filesystem fs; part_dev = dev } ->
+ | { Diskimage.part_content = `Filesystem fs;
+ part_dev = dev } ->
f dom ~disk ~partno:(i+1) dev fs
| _ -> ()
- ) partitions.parts
+ ) partitions.Diskimage.parts
| _ -> ()
) disks;
(* LV filesystems. *)
- List.iter (fun ({lv_dev = dev}, fs) -> f dom dev fs) filesystems
- ) doms
+ List.iter (
+ fun ({Diskimage.lv_dev = dev}, fs) -> f dom dev fs
+ ) filesystems
+ ) machines
in
(* Printable name is like "domain:hda" or "domain:hda1". *)
- let printable_name dom ?disk ?partno dev =
- let dom_name = dom.dom_name in
+ let printable_name machine ?disk ?partno dev =
+ let m_name = machine.Diskimage.m_name in
(* 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
+ | Some disk -> disk.Diskimage.d_name
in
match partno with
| None ->
- dom_name ^ ":" ^ disk_name
+ m_name ^ ":" ^ disk_name
| Some partno ->
- dom_name ^ ":" ^ disk_name ^ string_of_int partno
+ m_name ^ ":" ^ disk_name ^ string_of_int partno
in
(* Print stats for each recognized filesystem. *)
- let print_stats dom ?disk ?partno dev fs =
- let name = printable_name dom ?disk ?partno dev in
+ let print_stats machine ?disk ?partno dev fs =
+ let name = printable_name machine ?disk ?partno dev in
printf "%-32s " name;
- if fs.fs_is_swap then (
+ let {
+ Diskimage.fs_name = fs_name;
+ fs_block_size = fs_block_size;
+ fs_blocks_total = fs_blocks_total;
+ fs_is_swap = fs_is_swap;
+ fs_blocks_reserved = fs_blocks_reserved;
+ fs_blocks_avail = fs_blocks_avail;
+ fs_blocks_used = fs_blocks_used;
+ fs_inodes_total = fs_inodes_total;
+ fs_inodes_reserved = fs_inodes_reserved;
+ fs_inodes_avail = fs_inodes_avail;
+ fs_inodes_used = fs_inodes_used
+ } = fs in
+
+ if fs_is_swap then (
(* Swap partition. *)
if not !human then
printf "%10Ld %s\n"
- (fs.fs_block_size *^ fs.fs_blocks_total /^ 1024L) fs.fs_name
+ (fs_block_size *^ fs_blocks_total /^ 1024L) fs_name
else
printf "%10s %s\n"
- (printable_size (fs.fs_block_size *^ fs.fs_blocks_total)) fs.fs_name
+ (printable_size (fs_block_size *^ fs_blocks_total)) fs_name
) else (
(* Ordinary filesystem. *)
if not !inodes then ( (* Block display. *)
(* 'df' doesn't count the restricted blocks. *)
- let blocks_total = fs.fs_blocks_total -^ fs.fs_blocks_reserved in
- let blocks_avail = fs.fs_blocks_avail -^ fs.fs_blocks_reserved in
+ let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
+ let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in
if not !human then ( (* Display 1K blocks. *)
printf "%10Ld %10Ld %10Ld %s\n"
- (blocks_total *^ fs.fs_block_size /^ 1024L)
- (fs.fs_blocks_used *^ fs.fs_block_size /^ 1024L)
- (blocks_avail *^ fs.fs_block_size /^ 1024L)
- fs.fs_name
+ (blocks_total *^ fs_block_size /^ 1024L)
+ (fs_blocks_used *^ fs_block_size /^ 1024L)
+ (blocks_avail *^ fs_block_size /^ 1024L)
+ fs_name
) else ( (* Human-readable blocks. *)
printf "%10s %10s %10s %s\n"
- (printable_size (blocks_total *^ fs.fs_block_size))
- (printable_size (fs.fs_blocks_used *^ fs.fs_block_size))
- (printable_size (blocks_avail *^ fs.fs_block_size))
- fs.fs_name
+ (printable_size (blocks_total *^ fs_block_size))
+ (printable_size (fs_blocks_used *^ fs_block_size))
+ (printable_size (blocks_avail *^ fs_block_size))
+ fs_name
)
) else ( (* Inodes display. *)
printf "%10Ld %10Ld %10Ld %s\n"
- fs.fs_inodes_total fs.fs_inodes_used fs.fs_inodes_avail
- fs.fs_name
+ fs_inodes_total fs_inodes_used fs_inodes_avail
+ fs_name
)
)
in
* We ignore the human-readable option because we assume that
* the data will be post-processed by something.
*)
- let print_stats_csv dom ?disk ?partno dev fs =
- let name = printable_name dom ?disk ?partno dev in
+ let print_stats_csv machine ?disk ?partno dev fs =
+ let name = printable_name machine ?disk ?partno dev in
+
+ let {
+ Diskimage.fs_name = fs_name;
+ fs_block_size = fs_block_size;
+ fs_blocks_total = fs_blocks_total;
+ fs_is_swap = fs_is_swap;
+ fs_blocks_reserved = fs_blocks_reserved;
+ fs_blocks_avail = fs_blocks_avail;
+ fs_blocks_used = fs_blocks_used;
+ fs_inodes_total = fs_inodes_total;
+ fs_inodes_reserved = fs_inodes_reserved;
+ fs_inodes_avail = fs_inodes_avail;
+ fs_inodes_used = fs_inodes_used
+ } = fs in
let row =
- if fs.fs_is_swap then
+ if fs_is_swap then
(* Swap partition. *)
- [ Int64.to_string (fs.fs_block_size *^ fs.fs_blocks_total /^ 1024L);
+ [ Int64.to_string (fs_block_size *^ fs_blocks_total /^ 1024L);
""; "" ]
else (
(* Ordinary filesystem. *)
if not !inodes then ( (* Block display. *)
(* 'df' doesn't count the restricted blocks. *)
- let blocks_total = fs.fs_blocks_total -^ fs.fs_blocks_reserved in
- let blocks_avail = fs.fs_blocks_avail -^ fs.fs_blocks_reserved in
+ let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
+ let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in
- [ Int64.to_string (blocks_total *^ fs.fs_block_size /^ 1024L);
- Int64.to_string (fs.fs_blocks_used *^ fs.fs_block_size /^ 1024L);
- Int64.to_string (blocks_avail *^ fs.fs_block_size /^ 1024L) ]
+ [ Int64.to_string (blocks_total *^ fs_block_size /^ 1024L);
+ Int64.to_string (fs_blocks_used *^ fs_block_size /^ 1024L);
+ Int64.to_string (blocks_avail *^ fs_block_size /^ 1024L) ]
) else ( (* Inodes display. *)
- [ Int64.to_string fs.fs_inodes_total;
- Int64.to_string fs.fs_inodes_used;
- Int64.to_string fs.fs_inodes_avail ]
+ [ Int64.to_string fs_inodes_total;
+ Int64.to_string fs_inodes_used;
+ Int64.to_string fs_inodes_avail ]
)
) in
- let row = name :: row @ [fs.fs_name] in
+ let row = name :: row @ [fs_name] in
csv_write row
in
- iter_over_filesystems doms
+ iter_over_filesystems machines
(if not !csv_mode then print_stats else print_stats_csv)