open Printf
open ExtList
-open Unix
module C = Libvirt.Connect
module D = Libvirt.Domain
+open Int63.Operators
+
open Virt_df_gettext.Gettext
open Virt_df
+let disk_block_size = ~^512
+
+(* A libvirt-backed block device. *)
+class libvirt_device dom name path blocksize =
+ (* Size is never really used. *)
+ let size = ~^0 in
+object (self)
+ inherit Diskimage.device
+ method read offset len =
+ let offset = Int63.to_int64 offset in
+ let len = Int63.to_int len in
+ let str = String.make len '\000' in
+ ignore (D.block_peek dom path offset len str 0);
+ str
+ method size = size
+ method name = name
+ method blocksize = blocksize
+ method map_block _ = []
+ method contiguous offset = size -^ offset
+ method close () = ()
+ initializer
+ (* Check that access is possible - throws a virterror if not. *)
+ D.block_peek dom path 0L 0 "" 0
+end
+
let () =
(* Command line argument parsing. *)
let set_uri = function "" -> uri := None | u -> uri := Some u in
exit 0
in
- let test_mode filename =
- test_files := filename :: !test_files
- in
+ let test_mode filename = test_files := filename :: !test_files in
let argspec = Arg.align [
"-a", Arg.Set all,
"uri " ^ s_ "Connect to URI (default: Xen)";
"--connect", Arg.String set_uri,
"uri " ^ s_ "Connect to URI (default: Xen)";
- "--debug", Arg.Set debug,
+ "--csv", Arg.Set csv_mode,
+ " " ^ s_ "Write results in CSV format";
+ "--debug", Arg.Set Diskimage.debug,
" " ^ s_ "Debug mode (default: false)";
"-h", Arg.Set human,
" " ^ s_ "Print sizes in human-readable format";
Arg.parse argspec anon_fun usage_msg;
- let doms : domain list =
+ (* Set up CSV support. *)
+ let csv_write =
+ if not !csv_mode then
+ fun _ -> assert false (* Should never happen. *)
+ else
+ match !csv_write with
+ | None ->
+ prerr_endline (s_ "CSV is not supported in this build of virt-df");
+ exit 1
+ | Some csv_write ->
+ csv_write stdout
+ in
+
+ let doms =
if !test_files = [] then (
let xmls =
(* Connect to the hypervisor. *)
Libvirt.Virterror err ->
prerr_endline (Libvirt.Virterror.to_string err);
(* If non-root and no explicit connection URI, print a warning. *)
- if geteuid () <> 0 && name = None then (
+ if Unix.geteuid () <> 0 && name = None then (
print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
);
exit 1 in
) in
(* Get their XML. *)
- let xmls = List.map D.get_xml_desc doms in
+ let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
(* Parse the XML. *)
- let xmls = List.map Xml.parse_string xmls in
+ let xmls = List.map (fun (dom, xml) ->
+ dom, Xml.parse_string xml) xmls in
- (* Return just the XML documents - everything else will be closed
- * and freed including the connection to the hypervisor.
- *)
xmls in
(* Grr.. Need to use a library which has XPATH support (or cduce). *)
List.map (
- fun xml ->
+ fun (dom, xml) ->
let nodes, domain_attrs =
match xml with
| 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_error (err, func, param) ->
- eprintf "%s:%s: %s" func param (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 = [] }
+ let disks = List.filter_map (
+ fun (name, path) ->
+ try Some (name, new libvirt_device dom name path disk_block_size)
+ with Libvirt.Virterror err ->
+ eprintf "%s: %s\n" name (Libvirt.Virterror.to_string err);
+ None
+ ) disks in
+
+ name, disks
) xmls
) else (
(* In test mode (-t option) the user can pass one or more
* which we use for testing virt-df itself. We create fake domains
* from these.
*)
- List.map (
+ List.filter_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 = []
- }
+ try Some (filename,
+ ["hda",
+ new Diskimage.block_device filename disk_block_size])
+ with Unix.Unix_error (err, func, param) ->
+ eprintf "%s:%s: %s\n" func param (Unix.error_message err);
+ None
) !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.map (
+ fun (name, disks) -> Diskimage.open_machine_from_devices name disks
) 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
+ (* Scan them. *)
+ let machines = List.map Diskimage.scan_machine machines in
- let lvs =
- List.map (fun (pv, devs) -> list_lvs pv.lvm_plugin_id devs) lvs in
- let lvs = List.concat lvs in
+ (*----------------------------------------------------------------------*)
+ (* Now print the results. *)
- (* 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.
- *)
+ (* Print the title. *)
let () =
let total, used, avail =
match !inodes, !human with
| false, false -> s_ "1K-blocks", s_ "Used", s_ "Available"
| false, true -> s_ "Size", s_ "Used", s_ "Available"
| true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in
- printf "%-20s %10s %10s %10s %s\n%!"
- (s_ "Filesystem") total used avail (s_ "Type") in
+ if not !csv_mode then
+ printf "%-32s %10s %10s %10s %s\n%!"
+ (s_ "Filesystem") total used avail (s_ "Type")
+ else
+ csv_write [ "Filesystem"; total; used; avail; "Type" ] in
let printable_size bytes =
- if bytes < 1024L *^ 1024L then
- sprintf "%Ld bytes" bytes
- else if bytes < 1024L *^ 1024L *^ 1024L then
- sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.)
+ if bytes < ~^1024 *^ ~^1024 then
+ sprintf "%s bytes" (Int63.to_string bytes)
+ else if bytes < ~^1024 *^ ~^1024 *^ ~^1024 then
+ sprintf "%.1f MiB" (Int63.to_float (bytes /^ ~^1024) /. 1024.)
else
- sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.)
+ sprintf "%.1f GiB" (Int63.to_float (bytes /^ ~^1024 /^ ~^1024) /. 1024.)
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) ->
- f dom ~disk dev fs
- | ({ d_content = `Partitions partitions } as disk) ->
+ | ({ Diskimage.d_content = `Filesystem fs; d_dev = dev } as disk) ->
+ f dom ~disk (dev :> Diskimage.device) fs
+ | ({ 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
- (* Print stats for each recognized filesystem. *)
- 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
- (* 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 ^ ":" ^ disk_name
- | Some partno ->
- dom_name ^ ":" ^ disk_name ^ string_of_int partno in
- printf "%-20s " name;
+ (* Printable name is like "domain:hda" or "domain:hda1". *)
+ 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.Diskimage.d_name
+ in
+ match partno with
+ | None ->
+ m_name ^ ":" ^ disk_name
+ | Some partno ->
+ m_name ^ ":" ^ disk_name ^ string_of_int partno
+ in
- if fs.fs_is_swap then (
+ (* Print stats for each recognized filesystem. *)
+ let print_stats machine ?disk ?partno dev fs =
+ let name = printable_name machine ?disk ?partno dev in
+ printf "%-32s " name;
+
+ let {
+ Diskimage.fs_blocksize = fs_blocksize;
+ 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 fs_name = Diskimage.name_of_filesystem 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
+ printf "%10s %s\n"
+ (Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024))
+ fs_name
else
printf "%10s %s\n"
- (printable_size (fs.fs_block_size *^ fs.fs_blocks_total)) fs.fs_name
+ (printable_size (fs_blocksize *^ 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_avail = if blocks_avail < 0L then 0L else blocks_avail 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 < ~^0 then ~^0 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
+ printf "%10s %10s %10s %s\n"
+ (Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024))
+ (Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024))
+ (Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024))
+ 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_blocksize))
+ (printable_size (fs_blocks_used *^ fs_blocksize))
+ (printable_size (blocks_avail *^ fs_blocksize))
+ 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
+ printf "%10s %10s %10s %s\n"
+ (Int63.to_string fs_inodes_total)
+ (Int63.to_string fs_inodes_used)
+ (Int63.to_string fs_inodes_avail)
+ fs_name
)
)
in
- iter_over_filesystems doms print_stats
+
+ (* Alternate version of print_stats which writes to a CSV file.
+ * We ignore the human-readable option because we assume that
+ * the data will be post-processed by something.
+ *)
+ let print_stats_csv machine ?disk ?partno dev fs =
+ let name = printable_name machine ?disk ?partno dev in
+
+ let {
+ Diskimage.fs_blocksize = fs_blocksize;
+ 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 fs_name = Diskimage.name_of_filesystem fs in
+
+ let row =
+ if fs_is_swap then
+ (* Swap partition. *)
+ [ Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024);
+ ""; "" ]
+ else (
+ (* Ordinary filesystem. *)
+ if not !inodes then ( (* 1K block display. *)
+ (* 'df' doesn't count the restricted blocks. *)
+ 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 < ~^0 then ~^0 else blocks_avail in
+
+ [ Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024);
+ Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024);
+ Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024) ]
+ ) else ( (* Inodes display. *)
+ [ Int63.to_string fs_inodes_total;
+ Int63.to_string fs_inodes_used;
+ Int63.to_string fs_inodes_avail ]
+ )
+ ) in
+
+ let row = name :: row @ [fs_name] in
+ csv_write row
+ in
+
+ iter_over_filesystems machines
+ (if not !csv_mode then print_stats else print_stats_csv)
git.annexia.org / virt-df.git / blobdiff