1 (* 'df' command for virtual domains.
2 (C) Copyright 2007-2008 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.
24 open Virt_df_gettext.Gettext
26 module C = Libvirt.Connect
27 module D = Libvirt.Domain
28 module N = Libvirt.Network
30 (* Int64 operators for convenience.
31 * For sanity we do all int operations as int64's.
35 let ( *^ ) = Int64.mul
39 let inodes = ref false
43 (* Maximum number of extended partitions possible. *)
44 let max_extended_partitions = 100
46 let sector_size = 512L
48 (* Parse out the device XML to get the names of disks. *)
50 dom_name : string; (* Domain name. *)
51 dom_id : int option; (* Domain ID (if running). *)
52 dom_disks : disk list; (* Domain disks. *)
55 d_type : string option; (* The <disk type=...> *)
56 d_device : string option; (* The <disk device=...> *)
57 d_source : string option; (* The <source file=... or dev> *)
58 d_target : string option; (* The <target dev=...> *)
62 part_status : partition_status; (* Bootable, etc. *)
63 part_type : int; (* Partition type. *)
64 part_lba_start : int64; (* LBA start sector. *)
65 part_len : int64; (* Length in sectors. *)
67 and partition_status = Bootable | Nonbootable | Malformed | NullEntry
69 type filesystem_stats = {
71 fs_block_size : int64; (* Block size (bytes). *)
72 fs_blocks_total : int64; (* Total blocks. *)
73 fs_blocks_reserved : int64; (* Blocks reserved for super-user. *)
74 fs_blocks_avail : int64; (* Blocks free (available). *)
75 fs_blocks_used : int64; (* Blocks in use. *)
76 fs_inodes_total : int64; (* Total inodes. *)
77 fs_inodes_reserved : int64; (* Inodes reserved for super-user. *)
78 fs_inodes_avail : int64; (* Inodes free (available). *)
79 fs_inodes_used : int64; (* Inodes in use. *)
83 swap_block_size : int64; (* Block size (bytes). *)
84 swap_blocks_total : int64; (* Total blocks. *)
86 and fs_probe_t = (* Return type of the probe_partition.*)
87 | Filesystem of filesystem_stats
89 | ProbeFailed of string (* Probe failed for some reason. *)
90 | ProbeIgnore (* This filesystem should be ignored. *)
92 (* Register a filesystem type. *)
93 let filesystems = Hashtbl.create 13
94 let fs_register part_types probe_fn =
96 (fun part_type -> Hashtbl.replace filesystems part_type probe_fn)
99 (* Probe the devices and display.
100 * - dom_name is the domain name
101 * - target will be something like "hda"
102 * - source will be the name of a file or disk partition on the local machine
104 let rec probe_device dom_name target source =
105 let fd = openfile source [ O_RDONLY ] 0 in
106 let size = (LargeFile.fstat fd).LargeFile.st_size in
107 let size = size /^ sector_size in (* Size in sectors. *)
109 (*print_device dom_name target source size;*)
111 let partitions = probe_mbr fd in
113 if partitions <> [] then (
117 if part.part_status = Bootable ||
118 part.part_status = Nonbootable then (
120 let target = target ^ string_of_int pnum in
122 probe_partition target (Some part.part_type)
123 fd part.part_lba_start part.part_len)
128 let stats = List.filter_map (fun x -> x) stats in
129 print_stats dom_name stats
130 ) else (* Not an MBR, assume it's a single partition. *)
131 print_stats dom_name [target, probe_partition target None fd 0L size];
135 (* Probe the master boot record (if it is one) and read the partitions.
136 * Returns [] if this is not an MBR.
137 * http://en.wikipedia.org/wiki/Master_boot_record
140 lseek fd 510 SEEK_SET;
141 let str = String.create 2 in
142 if read fd str 0 2 <> 2 || str.[0] != '\x55' || str.[1] != '\xAA' then
145 (* Read the partition table. *)
146 lseek fd 446 SEEK_SET;
147 let str = String.create 64 in
148 if read fd str 0 64 <> 64 then
149 failwith (s_ "error reading partition table")
151 (* Extract partitions from the data. *)
152 let primaries = List.map (get_partition str) [ 0; 16; 32; 48 ] in
153 (* XXX validate partition extents compared to disk. *)
154 (* Read extended partition data. *)
155 let extendeds = List.map (
157 | { part_type = 0x05 } as part ->
158 probe_extended_partition
159 max_extended_partitions fd part part.part_lba_start
162 let extendeds = List.concat extendeds in
163 primaries @ extendeds
167 (* Probe an extended partition. *)
168 and probe_extended_partition max fd epart sect =
170 (* Offset of the first EBR. *)
171 let ebr_offs = sect *^ sector_size in
173 LargeFile.lseek fd (ebr_offs +^ 510L) SEEK_SET;
174 let str = String.create 2 in
175 if read fd str 0 2 <> 2 || str.[0] != '\x55' || str.[1] != '\xAA' then
178 (* Read the extended partition table entries (just 2 of them). *)
179 LargeFile.lseek fd (ebr_offs +^ 446L) SEEK_SET;
180 let str = String.create 32 in
181 if read fd str 0 32 <> 32 then
182 failwith (s_ "error reading extended partition")
184 (* Extract partitions from the data. *)
186 match List.map (get_partition str) [ 0; 16 ] with
188 | _ -> failwith (s_ "probe_extended_partition: internal error") in
189 (* First partition entry has offset to the start of this partition. *)
190 let part1 = { part1 with
191 part_lba_start = sect +^ part1.part_lba_start } in
192 (* Second partition entry is zeroes if end of list, otherwise points
193 * to the next partition.
195 if part2.part_status = NullEntry then
198 part1 :: probe_extended_partition
199 (max-1) fd epart (sect +^ part2.part_lba_start)
205 (* Get the partition data from str.[offs] - str.[offs+15] *)
206 and get_partition str offs =
207 let part_type = Char.code str.[offs+4] in
208 let part_lba_start = read_int32_le str (offs+8) in
209 let part_len = read_int32_le str (offs+12) in
212 if part_type = 0 && part_lba_start = 0L && part_len = 0L then
215 let part_status = Char.code str.[offs] in
216 match part_status with
217 | 0x80 -> Bootable | 0 -> Nonbootable | _ -> Malformed
220 { part_status = part_status;
221 part_type = part_type;
222 part_lba_start = part_lba_start;
223 part_len = part_len }
225 (* Probe a single partition, which we assume contains either a
226 * filesystem or is a PV.
227 * - target will be something like "hda" or "hda1"
228 * - part_type will be the partition type if known, or None
229 * - fd is a file descriptor opened on the device
230 * - start & size are where we think the start and size of the
231 * partition is within the file descriptor (in SECTORS)
233 and probe_partition target part_type fd start size =
236 ProbeFailed (s_ "detection of unpartitioned devices not yet supported")
238 ProbeIgnore (* Extended partition - ignore it. *)
241 let probe_fn = Hashtbl.find filesystems part_type in
242 probe_fn target part_type fd start size
246 (sprintf (f_ "unsupported partition type %02x") part_type)
248 and print_stats dom_name statss =
250 fun (target, fs_probe_t) ->
251 let dom_target = dom_name ^ ":" ^ target in
252 printf "%-20s " dom_target;
254 match fs_probe_t with
255 (* Swap partition. *)
256 | Swap { swap_name = swap_name;
257 swap_block_size = block_size;
258 swap_blocks_total = blocks_total } ->
261 (block_size *^ blocks_total /^ 1024L) swap_name
264 (printable_size (block_size *^ blocks_total)) swap_name
266 (* Ordinary filesystem. *)
267 | Filesystem stats ->
268 if not !inodes then ( (* Block display. *)
269 (* 'df' doesn't count the restricted blocks. *)
271 stats.fs_blocks_total -^ stats.fs_blocks_reserved in
273 stats.fs_blocks_avail -^ stats.fs_blocks_reserved in
275 if blocks_avail < 0L then 0L else blocks_avail in
277 if not !human then ( (* Display 1K blocks. *)
278 printf "%10Ld %10Ld %10Ld %s\n"
279 (blocks_total *^ stats.fs_block_size /^ 1024L)
280 (stats.fs_blocks_used *^ stats.fs_block_size /^ 1024L)
281 (blocks_avail *^ stats.fs_block_size /^ 1024L)
283 ) else ( (* Human-readable blocks. *)
284 printf "%10s %10s %10s %s\n"
285 (printable_size (blocks_total *^ stats.fs_block_size))
286 (printable_size (stats.fs_blocks_used *^ stats.fs_block_size))
287 (printable_size (blocks_avail *^ stats.fs_block_size))
290 ) else ( (* Inodes display. *)
291 printf "%10Ld %10Ld %10Ld %s\n"
292 stats.fs_inodes_total stats.fs_inodes_used stats.fs_inodes_avail
296 (* Unsupported filesystem or other failure. *)
297 | ProbeFailed reason ->
298 printf " %s\n" reason
303 (* Target is something like "hda" and size is the size in sectors. *)
304 and print_device dom_name target source size =
305 printf "%s /dev/%s (%s) %s\n"
306 dom_name target (printable_size (size *^ sector_size)) source
308 and printable_size bytes =
309 if bytes < 1024L *^ 1024L then
310 sprintf "%Ld bytes" bytes
311 else if bytes < 1024L *^ 1024L *^ 1024L then
312 sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.)
314 sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.)
316 and read_int32_le str offs =
317 Int64.of_int (Char.code str.[offs]) +^
318 256L *^ Int64.of_int (Char.code str.[offs+1]) +^
319 65536L *^ Int64.of_int (Char.code str.[offs+2]) +^
320 16777216L *^ Int64.of_int (Char.code str.[offs+3])
322 and read_int16_le str offs =
323 Int64.of_int (Char.code str.[offs]) +^
324 256L *^ Int64.of_int (Char.code str.[offs+1])
327 (* Command line argument parsing. *)
328 let set_uri = function "" -> uri := None | u -> uri := Some u in
331 printf "virt-df %s\n" (Libvirt_version.version);
333 let major, minor, release =
334 let v, _ = Libvirt.get_version () in
335 v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
336 printf "libvirt %d.%d.%d\n" major minor release;
340 let argspec = Arg.align [
342 " " ^ s_ "Show all domains (default: only active domains)";
343 "--all", Arg.Set all,
344 " " ^ s_ "Show all domains (default: only active domains)";
345 "-c", Arg.String set_uri,
346 "uri " ^ s_ "Connect to URI (default: Xen)";
347 "--connect", Arg.String set_uri,
348 "uri " ^ s_ "Connect to URI (default: Xen)";
350 " " ^ s_ "Print sizes in human-readable format";
351 "--human-readable", Arg.Set human,
352 " " ^ s_ "Print sizes in human-readable format";
353 "-i", Arg.Set inodes,
354 " " ^ s_ "Show inodes instead of blocks";
355 "--inodes", Arg.Set inodes,
356 " " ^ s_ "Show inodes instead of blocks";
357 "--version", Arg.Unit version,
358 " " ^ s_ "Display version and exit";
362 raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in
363 let usage_msg = s_ "virt-df : like 'df', shows disk space used in guests
370 Arg.parse argspec anon_fun usage_msg;
373 (* Connect to the hypervisor. *)
376 try C.connect_readonly ?name ()
378 Libvirt.Virterror err ->
379 prerr_endline (Libvirt.Virterror.to_string err);
380 (* If non-root and no explicit connection URI, print a warning. *)
381 if geteuid () <> 0 && name = None then (
382 print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
386 (* Get the list of active & inactive domains. *)
388 let nr_active_doms = C.num_of_domains conn in
389 let active_doms = Array.to_list (C.list_domains conn nr_active_doms) in
390 let active_doms = List.map (D.lookup_by_id conn) active_doms in
394 let nr_inactive_doms = C.num_of_defined_domains conn in
396 Array.to_list (C.list_defined_domains conn nr_inactive_doms) in
397 let inactive_doms = List.map (D.lookup_by_name conn) inactive_doms in
398 active_doms @ inactive_doms
402 let xmls = List.map D.get_xml_desc doms in
405 let xmls = List.map Xml.parse_string xmls in
407 (* Return just the XML documents - everything else will be closed
408 * and freed including the connection to the hypervisor.
412 let doms : domain list =
413 (* Grr.. Need to use a library which has XPATH support (or cduce). *)
416 let nodes, domain_attrs =
418 | Xml.Element ("domain", attrs, children) -> children, attrs
419 | _ -> failwith (s_ "get_xml_desc didn't return <domain/>") in
422 try Some (int_of_string (List.assoc "id" domain_attrs))
423 with Not_found -> None in
425 let rec loop = function
427 failwith (s_ "get_xml_desc returned no <name> node in XML")
428 | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name
429 | Xml.Element ("name", _, _) :: _ ->
430 failwith (s_ "get_xml_desc returned strange <name> node")
431 | _ :: rest -> loop rest
433 let name = loop nodes in
439 | Xml.Element ("devices", _, devices) -> Some devices
442 List.concat devices in
444 let rec target_dev_of = function
446 | Xml.Element ("target", attrs, _) :: rest ->
447 (try Some (List.assoc "dev" attrs)
448 with Not_found -> target_dev_of rest)
449 | _ :: rest -> target_dev_of rest
452 let rec source_file_of = function
454 | Xml.Element ("source", attrs, _) :: rest ->
455 (try Some (List.assoc "file" attrs)
456 with Not_found -> source_file_of rest)
457 | _ :: rest -> source_file_of rest
460 let rec source_dev_of = function
462 | Xml.Element ("source", attrs, _) :: rest ->
463 (try Some (List.assoc "dev" attrs)
464 with Not_found -> source_dev_of rest)
465 | _ :: rest -> source_dev_of rest
471 | Xml.Element ("disk", attrs, children) ->
473 try Some (List.assoc "type" attrs)
474 with Not_found -> None in
476 try Some (List.assoc "device" attrs)
477 with Not_found -> None in
479 match source_file_of children with
480 | (Some _) as source -> source
481 | None -> source_dev_of children in
482 let target = target_dev_of children in
485 d_type = typ; d_device = device;
486 d_source = source; d_target = target
491 { dom_name = name; dom_id = domid; dom_disks = disks }
494 (* Print the title. *)
496 let total, used, avail =
497 match !inodes, !human with
498 | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available"
499 | false, true -> s_ "Size", s_ "Used", s_ "Available"
500 | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in
501 printf "%-20s %10s %10s %10s %s\n%!"
502 (s_ "Filesystem") total used avail (s_ "Type") in
504 (* Probe the devices. *)
506 fun { dom_name = dom_name; dom_disks = dom_disks } ->
509 | { d_source = Some source; d_target = Some target } ->
510 probe_device dom_name target source
511 | { d_device = Some "cdrom" } ->
512 () (* Ignore physical CD-ROM devices. *)
514 print_endline (s_ "(device omitted)");