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
28 open Virt_df_gettext.Gettext
31 let disk_block_size = ~^512
33 (* A libvirt-backed block device. *)
34 class libvirt_device dom name path blocksize =
35 (* Size is never really used. *)
38 inherit Diskimage.device
39 method read offset len =
40 let offset = Int63.to_int64 offset in
41 let len = Int63.to_int len in
42 let str = String.make len '\000' in
43 ignore (D.block_peek dom path offset len str 0);
47 method blocksize = blocksize
48 method map_block _ = []
49 method contiguous offset = size -^ offset
52 (* Check that access is possible - throws a virterror if not. *)
53 D.block_peek dom path 0L 0 "" 0
57 (* Command line argument parsing. *)
58 let set_uri = function "" -> uri := None | u -> uri := Some u in
61 printf "virt-df %s\n" (Libvirt_version.version);
63 let major, minor, release =
64 let v, _ = Libvirt.get_version () in
65 v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
66 printf "libvirt %d.%d.%d\n" major minor release;
70 let test_mode filename = test_files := filename :: !test_files in
72 let argspec = Arg.align [
74 " " ^ s_ "Show all domains (default: only active domains)";
76 " " ^ s_ "Show all domains (default: only active domains)";
77 "-c", Arg.String set_uri,
78 "uri " ^ s_ "Connect to URI";
79 "--connect", Arg.String set_uri,
80 "uri " ^ s_ "Connect to URI";
81 "--csv", Arg.Set csv_mode,
82 " " ^ s_ "Write results in CSV format";
83 "--debug", Arg.Set Diskimage.debug,
84 " " ^ s_ "Debug mode (default: false)";
86 " " ^ s_ "Print sizes in human-readable format";
87 "--human-readable", Arg.Set human,
88 " " ^ s_ "Print sizes in human-readable format";
90 " " ^ s_ "Show inodes instead of blocks";
91 "--inodes", Arg.Set inodes,
92 " " ^ s_ "Show inodes instead of blocks";
93 "-t", Arg.String test_mode,
94 "dev " ^ s_ "(Test mode) Display contents of block device or file";
95 "--version", Arg.Unit version,
96 " " ^ s_ "Display version and exit";
100 raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in
101 let usage_msg = s_ "virt-df : like 'df', shows disk space used in guests
108 Arg.parse argspec anon_fun usage_msg;
110 (* Set up CSV support. *)
112 if not !csv_mode then
113 fun _ -> assert false (* Should never happen. *)
115 match !csv_write with
117 prerr_endline (s_ "CSV is not supported in this build of virt-df");
124 if !test_files = [] then (
126 (* Connect to the hypervisor. *)
129 try C.connect_readonly ?name ()
131 Libvirt.Virterror err ->
132 prerr_endline (Libvirt.Virterror.to_string err);
133 (* If non-root and no explicit connection URI, print a warning. *)
134 if Unix.geteuid () <> 0 && name = None then (
135 print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
139 (* Get the list of active & inactive domains. *)
141 let nr_active_doms = C.num_of_domains conn in
143 Array.to_list (C.list_domains conn nr_active_doms) in
145 List.map (D.lookup_by_id conn) active_doms in
149 let nr_inactive_doms = C.num_of_defined_domains conn in
151 Array.to_list (C.list_defined_domains conn nr_inactive_doms) in
153 List.map (D.lookup_by_name conn) inactive_doms in
154 active_doms @ inactive_doms
158 let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
161 let xmls = List.map (fun (dom, xml) ->
162 dom, Xml.parse_string xml) xmls in
166 (* Grr.. Need to use a library which has XPATH support (or cduce). *)
169 let nodes, domain_attrs =
171 | Xml.Element ("domain", attrs, children) -> children, attrs
172 | _ -> failwith (s_ "get_xml_desc didn't return <domain/>") in
175 try Some (int_of_string (List.assoc "id" domain_attrs))
176 with Not_found -> None in*)
178 let rec loop = function
180 failwith (s_ "get_xml_desc returned no <name> node in XML")
181 | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name
182 | Xml.Element ("name", _, _) :: _ ->
183 failwith (s_ "get_xml_desc returned strange <name> node")
184 | _ :: rest -> loop rest
186 let name = loop nodes in
192 | Xml.Element ("devices", _, devices) -> Some devices
195 List.concat devices in
197 let rec target_dev_of = function
199 | Xml.Element ("target", attrs, _) :: rest ->
200 (try Some (List.assoc "dev" attrs)
201 with Not_found -> target_dev_of rest)
202 | _ :: rest -> target_dev_of rest
205 let rec source_file_of = function
207 | Xml.Element ("source", attrs, _) :: rest ->
208 (try Some (List.assoc "file" attrs)
209 with Not_found -> source_file_of rest)
210 | _ :: rest -> source_file_of rest
213 let rec source_dev_of = function
215 | Xml.Element ("source", attrs, _) :: rest ->
216 (try Some (List.assoc "dev" attrs)
217 with Not_found -> source_dev_of rest)
218 | _ :: rest -> source_dev_of rest
224 | Xml.Element ("disk", attrs, children) ->
226 try Some (List.assoc "type" attrs)
227 with Not_found -> None in*)
229 try Some (List.assoc "device" attrs)
230 with Not_found -> None in
232 match source_file_of children with
233 | (Some _) as source -> source
234 | None -> source_dev_of children in
235 let target = target_dev_of children in
237 (* We only care about devices where we have
238 * source and target. Ignore CD-ROM devices.
240 (match source, target, device with
241 | _, _, Some "cdrom" -> None (* ignore CD-ROMs *)
242 | Some source, Some target, _ -> Some (target, source)
243 | _ -> None (* ignore anything else *)
249 let disks = List.filter_map (
251 try Some (name, new libvirt_device dom name path disk_block_size)
252 with Libvirt.Virterror err ->
253 eprintf "%s: %s\n" name (Libvirt.Virterror.to_string err);
260 (* In test mode (-t option) the user can pass one or more
261 * block devices or filenames (containing partitions/filesystems/etc)
262 * which we use for testing virt-df itself. We create fake domains
269 new Diskimage.block_device filename disk_block_size])
270 with Unix.Unix_error (err, func, param) ->
271 eprintf "%s:%s: %s\n" func param (Unix.error_message err);
276 (* Convert these to Diskimage library 'machine's. *)
277 let machines = List.map (
278 fun (name, disks) -> Diskimage.open_machine_from_devices name disks
282 let machines = List.map Diskimage.scan_machine machines in
284 (*----------------------------------------------------------------------*)
285 (* Now print the results. *)
287 (* Print the title. *)
289 let total, used, avail =
290 match !inodes, !human with
291 | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available"
292 | false, true -> s_ "Size", s_ "Used", s_ "Available"
293 | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in
294 if not !csv_mode then
295 printf "%-32s %10s %10s %10s %s\n%!"
296 (s_ "Filesystem") total used avail (s_ "Type")
298 csv_write [ "Filesystem"; total; used; avail; "Type" ] in
300 let printable_size bytes =
301 if bytes < ~^1024 *^ ~^1024 then
302 sprintf "%s bytes" (Int63.to_string bytes)
303 else if bytes < ~^1024 *^ ~^1024 *^ ~^1024 then
304 sprintf "%.1f MiB" (Int63.to_float (bytes /^ ~^1024) /. 1024.)
306 sprintf "%.1f GiB" (Int63.to_float (bytes /^ ~^1024 /^ ~^1024) /. 1024.)
309 (* HOF to iterate over filesystems. *)
310 let iter_over_filesystems machines
311 (f : Diskimage.machine -> ?disk:Diskimage.disk -> ?partno:int ->
312 Diskimage.device -> Diskimage.filesystem ->
315 fun ({ Diskimage.m_disks = disks;
316 m_lv_filesystems = filesystems } as dom) ->
317 (* Ordinary filesystems found on disks & partitions. *)
320 | ({ Diskimage.d_content = `Filesystem fs; d_dev = dev } as disk) ->
321 f dom ~disk (dev :> Diskimage.device) fs
322 | ({ Diskimage.d_content = `Partitions partitions } as disk) ->
326 | { Diskimage.part_content = `Filesystem fs;
328 f dom ~disk ~partno:(i+1) dev fs
330 ) partitions.Diskimage.parts
333 (* LV filesystems. *)
335 fun ({Diskimage.lv_dev = dev}, fs) -> f dom dev fs
340 (* Printable name is like "domain:hda" or "domain:hda1". *)
341 let printable_name machine ?disk ?partno dev =
342 let m_name = machine.Diskimage.m_name in
343 (* Get the disk name (eg. "hda") from the domain XML, if
344 * we have it, otherwise use the device name (eg. for LVM).
349 | Some disk -> disk.Diskimage.d_name
353 m_name ^ ":" ^ disk_name
355 m_name ^ ":" ^ disk_name ^ string_of_int partno
358 (* Print stats for each recognized filesystem. *)
359 let print_stats machine ?disk ?partno dev fs =
360 let name = printable_name machine ?disk ?partno dev in
361 printf "%-32s " name;
364 Diskimage.fs_blocksize = fs_blocksize;
365 fs_blocks_total = fs_blocks_total;
366 fs_is_swap = fs_is_swap;
367 fs_blocks_reserved = fs_blocks_reserved;
368 fs_blocks_avail = fs_blocks_avail;
369 fs_blocks_used = fs_blocks_used;
370 fs_inodes_total = fs_inodes_total;
371 fs_inodes_reserved = fs_inodes_reserved;
372 fs_inodes_avail = fs_inodes_avail;
373 fs_inodes_used = fs_inodes_used
376 let fs_name = Diskimage.name_of_filesystem fs in
379 (* Swap partition. *)
382 (Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024))
386 (printable_size (fs_blocksize *^ fs_blocks_total))
389 (* Ordinary filesystem. *)
390 if not !inodes then ( (* Block display. *)
391 (* 'df' doesn't count the restricted blocks. *)
392 let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
393 let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
394 let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
396 if not !human then ( (* Display 1K blocks. *)
397 printf "%10s %10s %10s %s\n"
398 (Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024))
399 (Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024))
400 (Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024))
402 ) else ( (* Human-readable blocks. *)
403 printf "%10s %10s %10s %s\n"
404 (printable_size (blocks_total *^ fs_blocksize))
405 (printable_size (fs_blocks_used *^ fs_blocksize))
406 (printable_size (blocks_avail *^ fs_blocksize))
409 ) else ( (* Inodes display. *)
410 printf "%10s %10s %10s %s\n"
411 (Int63.to_string fs_inodes_total)
412 (Int63.to_string fs_inodes_used)
413 (Int63.to_string fs_inodes_avail)
419 (* Alternate version of print_stats which writes to a CSV file.
420 * We ignore the human-readable option because we assume that
421 * the data will be post-processed by something.
423 let print_stats_csv machine ?disk ?partno dev fs =
424 let name = printable_name machine ?disk ?partno dev in
427 Diskimage.fs_blocksize = fs_blocksize;
428 fs_blocks_total = fs_blocks_total;
429 fs_is_swap = fs_is_swap;
430 fs_blocks_reserved = fs_blocks_reserved;
431 fs_blocks_avail = fs_blocks_avail;
432 fs_blocks_used = fs_blocks_used;
433 fs_inodes_total = fs_inodes_total;
434 fs_inodes_reserved = fs_inodes_reserved;
435 fs_inodes_avail = fs_inodes_avail;
436 fs_inodes_used = fs_inodes_used
439 let fs_name = Diskimage.name_of_filesystem fs in
443 (* Swap partition. *)
444 [ Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024);
447 (* Ordinary filesystem. *)
448 if not !inodes then ( (* 1K block display. *)
449 (* 'df' doesn't count the restricted blocks. *)
450 let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
451 let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
452 let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
454 [ Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024);
455 Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024);
456 Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024) ]
457 ) else ( (* Inodes display. *)
458 [ Int63.to_string fs_inodes_total;
459 Int63.to_string fs_inodes_used;
460 Int63.to_string fs_inodes_avail ]
464 let row = name :: row @ [fs_name] in
468 iter_over_filesystems machines
469 (if not !csv_mode then print_stats else print_stats_csv)