1 (* 'df' command for virtual domains.
2 (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
23 module C = Libvirt.Connect
24 module D = Libvirt.Domain
26 open Virt_df_gettext.Gettext
29 let ( +* ) = Int32.add
30 let ( -* ) = Int32.sub
31 let ( ** ) = Int32.mul
32 let ( /* ) = Int32.div
34 let ( +^ ) = Int64.add
35 let ( -^ ) = Int64.sub
36 let ( *^ ) = Int64.mul
37 let ( /^ ) = Int64.div
40 (* Command line argument parsing. *)
41 let set_uri = function "" -> uri := None | u -> uri := Some u in
44 printf "virt-df %s\n" (Libvirt_version.version);
46 let major, minor, release =
47 let v, _ = Libvirt.get_version () in
48 v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
49 printf "libvirt %d.%d.%d\n" major minor release;
53 let test_mode filename = test_files := filename :: !test_files in
55 let argspec = Arg.align [
57 " " ^ s_ "Show all domains (default: only active domains)";
59 " " ^ s_ "Show all domains (default: only active domains)";
60 "-c", Arg.String set_uri,
61 "uri " ^ s_ "Connect to URI (default: Xen)";
62 "--connect", Arg.String set_uri,
63 "uri " ^ s_ "Connect to URI (default: Xen)";
64 "--csv", Arg.Set csv_mode,
65 " " ^ s_ "Write results in CSV format";
66 "--debug", Arg.Set Diskimage.debug,
67 " " ^ s_ "Debug mode (default: false)";
69 " " ^ s_ "Print sizes in human-readable format";
70 "--human-readable", Arg.Set human,
71 " " ^ s_ "Print sizes in human-readable format";
73 " " ^ s_ "Show inodes instead of blocks";
74 "--inodes", Arg.Set inodes,
75 " " ^ s_ "Show inodes instead of blocks";
76 "-t", Arg.String test_mode,
77 "dev " ^ s_ "(Test mode) Display contents of block device or file";
78 "--version", Arg.Unit version,
79 " " ^ s_ "Display version and exit";
83 raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in
84 let usage_msg = s_ "virt-df : like 'df', shows disk space used in guests
91 Arg.parse argspec anon_fun usage_msg;
93 (* Set up CSV support. *)
96 fun _ -> assert false (* Should never happen. *)
100 prerr_endline (s_ "CSV is not supported in this build of virt-df");
106 (* name target dev_path *)
107 let doms : (string * (string * string) list) list =
108 if !test_files = [] then (
110 (* Connect to the hypervisor. *)
113 try C.connect_readonly ?name ()
115 Libvirt.Virterror err ->
116 prerr_endline (Libvirt.Virterror.to_string err);
117 (* If non-root and no explicit connection URI, print a warning. *)
118 if Unix.geteuid () <> 0 && name = None then (
119 print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
123 (* Get the list of active & inactive domains. *)
125 let nr_active_doms = C.num_of_domains conn in
127 Array.to_list (C.list_domains conn nr_active_doms) in
129 List.map (D.lookup_by_id conn) active_doms in
133 let nr_inactive_doms = C.num_of_defined_domains conn in
135 Array.to_list (C.list_defined_domains conn nr_inactive_doms) in
137 List.map (D.lookup_by_name conn) inactive_doms in
138 active_doms @ inactive_doms
142 let xmls = List.map D.get_xml_desc doms in
145 let xmls = List.map Xml.parse_string xmls in
147 (* Return just the XML documents - everything else will be closed
148 * and freed including the connection to the hypervisor.
152 (* Grr.. Need to use a library which has XPATH support (or cduce). *)
155 let nodes, domain_attrs =
157 | Xml.Element ("domain", attrs, children) -> children, attrs
158 | _ -> failwith (s_ "get_xml_desc didn't return <domain/>") in
161 try Some (int_of_string (List.assoc "id" domain_attrs))
162 with Not_found -> None in*)
164 let rec loop = function
166 failwith (s_ "get_xml_desc returned no <name> node in XML")
167 | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name
168 | Xml.Element ("name", _, _) :: _ ->
169 failwith (s_ "get_xml_desc returned strange <name> node")
170 | _ :: rest -> loop rest
172 let name = loop nodes in
178 | Xml.Element ("devices", _, devices) -> Some devices
181 List.concat devices in
183 let rec target_dev_of = function
185 | Xml.Element ("target", attrs, _) :: rest ->
186 (try Some (List.assoc "dev" attrs)
187 with Not_found -> target_dev_of rest)
188 | _ :: rest -> target_dev_of rest
191 let rec source_file_of = function
193 | Xml.Element ("source", attrs, _) :: rest ->
194 (try Some (List.assoc "file" attrs)
195 with Not_found -> source_file_of rest)
196 | _ :: rest -> source_file_of rest
199 let rec source_dev_of = function
201 | Xml.Element ("source", attrs, _) :: rest ->
202 (try Some (List.assoc "dev" attrs)
203 with Not_found -> source_dev_of rest)
204 | _ :: rest -> source_dev_of rest
210 | Xml.Element ("disk", attrs, children) ->
212 try Some (List.assoc "type" attrs)
213 with Not_found -> None in*)
215 try Some (List.assoc "device" attrs)
216 with Not_found -> None in
218 match source_file_of children with
219 | (Some _) as source -> source
220 | None -> source_dev_of children in
221 let target = target_dev_of children in
223 (* We only care about devices where we have
224 * source and target. Ignore CD-ROM devices.
226 (match source, target, device with
227 | _, _, Some "cdrom" -> None (* ignore CD-ROMs *)
228 | Some source, Some target, _ -> Some (target, source)
229 | _ -> None (* ignore anything else *)
238 (* In test mode (-t option) the user can pass one or more
239 * block devices or filenames (containing partitions/filesystems/etc)
240 * which we use for testing virt-df itself. We create fake domains
245 filename, ["hda", filename]
249 (* Convert these to Diskimage library 'machine's. *)
250 let machines = List.filter_map (
252 try Some (Diskimage.open_machine name disks)
253 with Unix.Unix_error (err, func, param) ->
254 eprintf "%s:%s: %s" func param (Unix.error_message err);
259 let machines = List.map Diskimage.scan_machine machines in
261 (*----------------------------------------------------------------------*)
262 (* Now print the results. *)
264 (* Print the title. *)
266 let total, used, avail =
267 match !inodes, !human with
268 | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available"
269 | false, true -> s_ "Size", s_ "Used", s_ "Available"
270 | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in
271 if not !csv_mode then
272 printf "%-32s %10s %10s %10s %s\n%!"
273 (s_ "Filesystem") total used avail (s_ "Type")
275 csv_write [ "Filesystem"; total; used; avail; "Type" ] in
277 let printable_size bytes =
278 if bytes < 1024L *^ 1024L then
279 sprintf "%Ld bytes" bytes
280 else if bytes < 1024L *^ 1024L *^ 1024L then
281 sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.)
283 sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.)
286 (* HOF to iterate over filesystems. *)
287 let iter_over_filesystems machines
288 (f : Diskimage.machine -> ?disk:Diskimage.disk -> ?partno:int ->
289 Diskimage.device -> Diskimage.filesystem ->
292 fun ({ Diskimage.m_disks = disks;
293 m_lv_filesystems = filesystems } as dom) ->
294 (* Ordinary filesystems found on disks & partitions. *)
297 | ({ Diskimage.d_content = `Filesystem fs; d_dev = dev } as disk) ->
298 f dom ~disk (dev :> Diskimage.device) fs
299 | ({ Diskimage.d_content = `Partitions partitions } as disk) ->
303 | { Diskimage.part_content = `Filesystem fs;
305 f dom ~disk ~partno:(i+1) dev fs
307 ) partitions.Diskimage.parts
310 (* LV filesystems. *)
312 fun ({Diskimage.lv_dev = dev}, fs) -> f dom dev fs
317 (* Printable name is like "domain:hda" or "domain:hda1". *)
318 let printable_name machine ?disk ?partno dev =
319 let m_name = machine.Diskimage.m_name in
320 (* Get the disk name (eg. "hda") from the domain XML, if
321 * we have it, otherwise use the device name (eg. for LVM).
326 | Some disk -> disk.Diskimage.d_name
330 m_name ^ ":" ^ disk_name
332 m_name ^ ":" ^ disk_name ^ string_of_int partno
335 (* Print stats for each recognized filesystem. *)
336 let print_stats machine ?disk ?partno dev fs =
337 let name = printable_name machine ?disk ?partno dev in
338 printf "%-32s " name;
341 Diskimage.fs_plugin_id = fs_plugin_id;
342 fs_block_size = fs_block_size;
343 fs_blocks_total = fs_blocks_total;
344 fs_is_swap = fs_is_swap;
345 fs_blocks_reserved = fs_blocks_reserved;
346 fs_blocks_avail = fs_blocks_avail;
347 fs_blocks_used = fs_blocks_used;
348 fs_inodes_total = fs_inodes_total;
349 fs_inodes_reserved = fs_inodes_reserved;
350 fs_inodes_avail = fs_inodes_avail;
351 fs_inodes_used = fs_inodes_used
354 let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
357 (* Swap partition. *)
360 (fs_block_size *^ fs_blocks_total /^ 1024L) fs_name
363 (printable_size (fs_block_size *^ fs_blocks_total)) fs_name
365 (* Ordinary filesystem. *)
366 if not !inodes then ( (* Block display. *)
367 (* 'df' doesn't count the restricted blocks. *)
368 let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
369 let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
370 let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in
372 if not !human then ( (* Display 1K blocks. *)
373 printf "%10Ld %10Ld %10Ld %s\n"
374 (blocks_total *^ fs_block_size /^ 1024L)
375 (fs_blocks_used *^ fs_block_size /^ 1024L)
376 (blocks_avail *^ fs_block_size /^ 1024L)
378 ) else ( (* Human-readable blocks. *)
379 printf "%10s %10s %10s %s\n"
380 (printable_size (blocks_total *^ fs_block_size))
381 (printable_size (fs_blocks_used *^ fs_block_size))
382 (printable_size (blocks_avail *^ fs_block_size))
385 ) else ( (* Inodes display. *)
386 printf "%10Ld %10Ld %10Ld %s\n"
387 fs_inodes_total fs_inodes_used fs_inodes_avail
393 (* Alternate version of print_stats which writes to a CSV file.
394 * We ignore the human-readable option because we assume that
395 * the data will be post-processed by something.
397 let print_stats_csv machine ?disk ?partno dev fs =
398 let name = printable_name machine ?disk ?partno dev in
401 Diskimage.fs_plugin_id = fs_plugin_id;
402 fs_block_size = fs_block_size;
403 fs_blocks_total = fs_blocks_total;
404 fs_is_swap = fs_is_swap;
405 fs_blocks_reserved = fs_blocks_reserved;
406 fs_blocks_avail = fs_blocks_avail;
407 fs_blocks_used = fs_blocks_used;
408 fs_inodes_total = fs_inodes_total;
409 fs_inodes_reserved = fs_inodes_reserved;
410 fs_inodes_avail = fs_inodes_avail;
411 fs_inodes_used = fs_inodes_used
414 let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
418 (* Swap partition. *)
419 [ Int64.to_string (fs_block_size *^ fs_blocks_total /^ 1024L);
422 (* Ordinary filesystem. *)
423 if not !inodes then ( (* Block display. *)
424 (* 'df' doesn't count the restricted blocks. *)
425 let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
426 let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
427 let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in
429 [ Int64.to_string (blocks_total *^ fs_block_size /^ 1024L);
430 Int64.to_string (fs_blocks_used *^ fs_block_size /^ 1024L);
431 Int64.to_string (blocks_avail *^ fs_block_size /^ 1024L) ]
432 ) else ( (* Inodes display. *)
433 [ Int64.to_string fs_inodes_total;
434 Int64.to_string fs_inodes_used;
435 Int64.to_string fs_inodes_avail ]
439 let row = name :: row @ [fs_name] in
443 iter_over_filesystems machines
444 (if not !csv_mode then print_stats else print_stats_csv)