(* 'df' command for virtual domains.
(C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
http://libvirt.org/
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*)
open Printf
open ExtList
open Unix
module C = Libvirt.Connect
module D = Libvirt.Domain
open Virt_df_gettext.Gettext
open Virt_df
let () =
(* Command line argument parsing. *)
let set_uri = function "" -> uri := None | u -> uri := Some u in
let version () =
printf "virt-df %s\n" (Libvirt_version.version);
let major, minor, release =
let v, _ = Libvirt.get_version () in
v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
printf "libvirt %d.%d.%d\n" major minor release;
exit 0
in
let test_mode filename =
test_files := filename :: !test_files
in
let argspec = Arg.align [
"-a", Arg.Set all,
" " ^ s_ "Show all domains (default: only active domains)";
"--all", Arg.Set all,
" " ^ s_ "Show all domains (default: only active domains)";
"-c", Arg.String set_uri,
"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,
" " ^ s_ "Print sizes in human-readable format";
"-i", Arg.Set inodes,
" " ^ s_ "Show inodes instead of blocks";
"--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";
"--version", Arg.Unit version,
" " ^ s_ "Display version and exit";
] in
let anon_fun str =
raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in
let usage_msg = s_ "virt-df : like 'df', shows disk space used in guests
SUMMARY
virt-df [-options]
OPTIONS" in
Arg.parse argspec anon_fun usage_msg;
let doms : domain list =
if !test_files = [] then (
let xmls =
(* Connect to the hypervisor. *)
let conn =
let name = !uri in
try C.connect_readonly ?name ()
with
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 (
print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
);
exit 1 in
(* Get the list of active & inactive domains. *)
let doms =
let nr_active_doms = C.num_of_domains conn in
let active_doms =
Array.to_list (C.list_domains conn nr_active_doms) in
let active_doms =
List.map (D.lookup_by_id conn) active_doms in
if not !all then
active_doms
else (
let nr_inactive_doms = C.num_of_defined_domains conn in
let inactive_doms =
Array.to_list (C.list_defined_domains conn nr_inactive_doms) in
let inactive_doms =
List.map (D.lookup_by_name conn) inactive_doms in
active_doms @ inactive_doms
) in
(* Get their XML. *)
let xmls = List.map D.get_xml_desc doms in
(* Parse the XML. *)
let xmls = List.map Xml.parse_string 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 ->
let nodes, domain_attrs =
match xml with
| Xml.Element ("domain", attrs, children) -> children, attrs
| _ -> failwith (s_ "get_xml_desc didn't return ") in
let domid =
try Some (int_of_string (List.assoc "id" domain_attrs))
with Not_found -> None in
let rec loop = function
| [] ->
failwith (s_ "get_xml_desc returned no node in XML")
| Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name
| Xml.Element ("name", _, _) :: _ ->
failwith (s_ "get_xml_desc returned strange node")
| _ :: rest -> loop rest
in
let name = loop nodes in
let devices =
let devices =
List.filter_map (
function
| Xml.Element ("devices", _, devices) -> Some devices
| _ -> None
) nodes in
List.concat devices in
let rec target_dev_of = function
| [] -> None
| Xml.Element ("target", attrs, _) :: rest ->
(try Some (List.assoc "dev" attrs)
with Not_found -> target_dev_of rest)
| _ :: rest -> target_dev_of rest
in
let rec source_file_of = function
| [] -> None
| Xml.Element ("source", attrs, _) :: rest ->
(try Some (List.assoc "file" attrs)
with Not_found -> source_file_of rest)
| _ :: rest -> source_file_of rest
in
let rec source_dev_of = function
| [] -> None
| Xml.Element ("source", attrs, _) :: rest ->
(try Some (List.assoc "dev" attrs)
with Not_found -> source_dev_of rest)
| _ :: rest -> source_dev_of rest
in
let disks =
List.filter_map (
function
| Xml.Element ("disk", attrs, children) ->
let typ =
try Some (List.assoc "type" attrs)
with Not_found -> None in
let device =
try Some (List.assoc "device" attrs)
with Not_found -> None in
let source =
match source_file_of children with
| (Some _) as source -> source
| None -> source_dev_of children in
let target = target_dev_of children in
(* We only care about devices where we have
* 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
)
| _ -> None (* ignore anything else *)
)
| _ -> None
) devices in
{ 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
* block devices or filenames (containing partitions/filesystems/etc)
* which we use for testing virt-df itself. We create fake domains
* from these.
*)
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 = []
}
) !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
) 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
| 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
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.)
else
sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.)
in
(* HOF to iterate over filesystems. *)
let iter_over_filesystems doms
(f : domain -> ?disk:disk -> ?partno:int -> device -> filesystem ->
unit) =
List.iter (
fun ({ dom_disks = disks; dom_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) ->
List.iteri (
fun i ->
function
| { part_content = `Filesystem fs; part_dev = dev } ->
f dom ~disk ~partno:(i+1) dev fs
| _ -> ()
) partitions.parts
| _ -> ()
) 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 ?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;
if fs.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
else
printf "%10s %s\n"
(printable_size (fs.fs_block_size *^ fs.fs_blocks_total)) fs.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
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
) 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
)
) else ( (* Inodes display. *)
printf "%10Ld %10Ld %10Ld %s\n"
fs.fs_inodes_total fs.fs_inodes_used fs.fs_inodes_avail
fs.fs_name
)
)
in
iter_over_filesystems doms print_stats