virt-df/virt_df_main.ml

   1 (* 'df' command for virtual domains.
   2    (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4
   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.
   9
  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.
  14
  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.
  18  *)
  19
  20 open Printf
  21 open ExtList
  22
  23 module C = Libvirt.Connect
  24 module D = Libvirt.Domain
  25
  26 open Int63.Operators
  27
  28 open Virt_df_gettext.Gettext
  29 open Virt_df
  30
  31 let () =
  32   (* Command line argument parsing. *)
  33   let set_uri = function "" -> uri := None | u -> uri := Some u in
  34
  35   let version () =
  36     printf "virt-df %s\n" (Libvirt_version.version);
  37
  38     let major, minor, release =
  39       let v, _ = Libvirt.get_version () in
  40       v / 1_000_000, (v / 1_000) mod 1_000, v mod 1_000 in
  41     printf "libvirt %d.%d.%d\n" major minor release;
  42     exit 0
  43   in
  44
  45   let test_mode filename = test_files := filename :: !test_files in
  46
  47   let argspec = Arg.align [
  48     "-a", Arg.Set all,
  49       " " ^ s_ "Show all domains (default: only active domains)";
  50     "--all", Arg.Set all,
  51       " " ^ s_ "Show all domains (default: only active domains)";
  52     "-c", Arg.String set_uri,
  53       "uri " ^ s_ "Connect to URI (default: Xen)";
  54     "--connect", Arg.String set_uri,
  55       "uri " ^ s_ "Connect to URI (default: Xen)";
  56     "--csv", Arg.Set csv_mode,
  57       " " ^ s_ "Write results in CSV format";
  58     "--debug", Arg.Set Diskimage.debug,
  59       " " ^ s_ "Debug mode (default: false)";
  60     "-h", Arg.Set human,
  61       " " ^ s_ "Print sizes in human-readable format";
  62     "--human-readable", Arg.Set human,
  63       " " ^ s_ "Print sizes in human-readable format";
  64     "-i", Arg.Set inodes,
  65       " " ^ s_ "Show inodes instead of blocks";
  66     "--inodes", Arg.Set inodes,
  67       " " ^ s_ "Show inodes instead of blocks";
  68     "-t", Arg.String test_mode,
  69       "dev " ^ s_ "(Test mode) Display contents of block device or file";
  70     "--version", Arg.Unit version,
  71       " " ^ s_ "Display version and exit";
  72   ] in
  73
  74   let anon_fun str =
  75     raise (Arg.Bad (sprintf (f_ "%s: unknown parameter") str)) in
  76   let usage_msg = s_ "virt-df : like 'df', shows disk space used in guests
  77
  78 SUMMARY
  79   virt-df [-options]
  80
  81 OPTIONS" in
  82
  83   Arg.parse argspec anon_fun usage_msg;
  84
  85   (* Set up CSV support. *)
  86   let csv_write =
  87     if not !csv_mode then
  88       fun _ -> assert false (* Should never happen. *)
  89     else
  90       match !csv_write with
  91       | None ->
  92           prerr_endline (s_ "CSV is not supported in this build of virt-df");
  93           exit 1
  94       | Some csv_write ->
  95           csv_write stdout
  96   in
  97
  98   (*          name      target   dev_path *)
  99   let doms : (string * (string * string) list) list =
 100     if !test_files = [] then (
 101       let xmls =
 102         (* Connect to the hypervisor. *)
 103         let conn =
 104           let name = !uri in
 105           try C.connect_readonly ?name ()
 106           with
 107             Libvirt.Virterror err ->
 108               prerr_endline (Libvirt.Virterror.to_string err);
 109               (* If non-root and no explicit connection URI, print a warning. *)
 110               if Unix.geteuid () <> 0 && name = None then (
 111                 print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root");
 112               );
 113               exit 1 in
 114
 115         (* Get the list of active & inactive domains. *)
 116         let doms =
 117           let nr_active_doms = C.num_of_domains conn in
 118           let active_doms =
 119             Array.to_list (C.list_domains conn nr_active_doms) in
 120           let active_doms =
 121             List.map (D.lookup_by_id conn) active_doms in
 122           if not !all then
 123             active_doms
 124           else (
 125             let nr_inactive_doms = C.num_of_defined_domains conn in
 126             let inactive_doms =
 127               Array.to_list (C.list_defined_domains conn nr_inactive_doms) in
 128             let inactive_doms =
 129               List.map (D.lookup_by_name conn) inactive_doms in
 130             active_doms @ inactive_doms
 131           ) in
 132
 133         (* Get their XML. *)
 134         let xmls = List.map D.get_xml_desc doms in
 135
 136         (* Parse the XML. *)
 137         let xmls = List.map Xml.parse_string xmls in
 138
 139         (* Return just the XML documents - everything else will be closed
 140          * and freed including the connection to the hypervisor.
 141          *)
 142         xmls in
 143
 144       (* Grr.. Need to use a library which has XPATH support (or cduce). *)
 145       List.map (
 146         fun xml ->
 147           let nodes, domain_attrs =
 148             match xml with
 149             | Xml.Element ("domain", attrs, children) -> children, attrs
 150             | _ -> failwith (s_ "get_xml_desc didn't return <domain/>") in
 151
 152           (*let domid =
 153             try Some (int_of_string (List.assoc "id" domain_attrs))
 154             with Not_found -> None in*)
 155
 156           let rec loop = function
 157             | [] ->
 158                 failwith (s_ "get_xml_desc returned no <name> node in XML")
 159             | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name
 160             | Xml.Element ("name", _, _) :: _ ->
 161                 failwith (s_ "get_xml_desc returned strange <name> node")
 162             | _ :: rest -> loop rest
 163           in
 164           let name = loop nodes in
 165
 166           let devices =
 167             let devices =
 168               List.filter_map (
 169                 function
 170                 | Xml.Element ("devices", _, devices) -> Some devices
 171                 | _ -> None
 172               ) nodes in
 173             List.concat devices in
 174
 175           let rec target_dev_of = function
 176             | [] -> None
 177             | Xml.Element ("target", attrs, _) :: rest ->
 178                 (try Some (List.assoc "dev" attrs)
 179                  with Not_found -> target_dev_of rest)
 180             | _ :: rest -> target_dev_of rest
 181           in
 182
 183           let rec source_file_of = function
 184             | [] -> None
 185             | Xml.Element ("source", attrs, _) :: rest ->
 186                 (try Some (List.assoc "file" attrs)
 187                  with Not_found -> source_file_of rest)
 188             | _ :: rest -> source_file_of rest
 189           in
 190
 191           let rec source_dev_of = function
 192             | [] -> None
 193             | Xml.Element ("source", attrs, _) :: rest ->
 194                 (try Some (List.assoc "dev" attrs)
 195                  with Not_found -> source_dev_of rest)
 196             | _ :: rest -> source_dev_of rest
 197           in
 198
 199           let disks =
 200             List.filter_map (
 201               function
 202               | Xml.Element ("disk", attrs, children) ->
 203                   (*let typ =
 204                     try Some (List.assoc "type" attrs)
 205                     with Not_found -> None in*)
 206                   let device =
 207                     try Some (List.assoc "device" attrs)
 208                     with Not_found -> None in
 209                   let source =
 210                     match source_file_of children with
 211                     | (Some _) as source -> source
 212                     | None -> source_dev_of children in
 213                   let target = target_dev_of children in
 214
 215                   (* We only care about devices where we have
 216                    * source and target.  Ignore CD-ROM devices.
 217                    *)
 218                   (match source, target, device with
 219                    | _, _, Some "cdrom" -> None (* ignore CD-ROMs *)
 220                    | Some source, Some target, _ -> Some (target, source)
 221                    | _ -> None (* ignore anything else *)
 222                   )
 223
 224               | _ -> None
 225             ) devices in
 226
 227           name, disks
 228       ) xmls
 229     ) else (
 230       (* In test mode (-t option) the user can pass one or more
 231        * block devices or filenames (containing partitions/filesystems/etc)
 232        * which we use for testing virt-df itself.  We create fake domains
 233        * from these.
 234        *)
 235       List.map (
 236         fun filename ->
 237           filename, ["hda", filename]
 238       ) !test_files
 239     ) in
 240
 241   (* Convert these to Diskimage library 'machine's. *)
 242   let machines = List.filter_map (
 243     fun (name, disks) ->
 244       try Some (Diskimage.open_machine name disks)
 245       with Unix.Unix_error (err, func, param) ->
 246         eprintf "%s:%s: %s" func param (Unix.error_message err);
 247         None
 248   ) doms in
 249
 250   (* Scan them. *)
 251   let machines = List.map Diskimage.scan_machine machines in
 252
 253   (*----------------------------------------------------------------------*)
 254   (* Now print the results. *)
 255
 256   (* Print the title. *)
 257   let () =
 258     let total, used, avail =
 259       match !inodes, !human with
 260       | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available"
 261       | false, true -> s_ "Size", s_ "Used", s_ "Available"
 262       | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in
 263     if not !csv_mode then
 264       printf "%-32s %10s %10s %10s %s\n%!"
 265         (s_ "Filesystem") total used avail (s_ "Type")
 266     else
 267       csv_write [ "Filesystem"; total; used; avail; "Type" ] in
 268
 269   let printable_size bytes =
 270     if bytes < ~^1024 *^ ~^1024 then
 271       sprintf "%s bytes" (Int63.to_string bytes)
 272     else if bytes < ~^1024 *^ ~^1024 *^ ~^1024 then
 273       sprintf "%.1f MiB" (Int63.to_float (bytes /^ ~^1024) /. 1024.)
 274     else
 275       sprintf "%.1f GiB" (Int63.to_float (bytes /^ ~^1024 /^ ~^1024) /. 1024.)
 276   in
 277
 278   (* HOF to iterate over filesystems. *)
 279   let iter_over_filesystems machines
 280       (f : Diskimage.machine -> ?disk:Diskimage.disk -> ?partno:int ->
 281         Diskimage.device -> Diskimage.filesystem ->
 282         unit) =
 283     List.iter (
 284       fun ({ Diskimage.m_disks = disks;
 285              m_lv_filesystems = filesystems } as dom) ->
 286         (* Ordinary filesystems found on disks & partitions. *)
 287         List.iter (
 288           function
 289           | ({ Diskimage.d_content = `Filesystem fs; d_dev = dev } as disk) ->
 290               f dom ~disk (dev :> Diskimage.device) fs
 291           | ({ Diskimage.d_content = `Partitions partitions } as disk) ->
 292               List.iteri (
 293                 fun i ->
 294                   function
 295                   | { Diskimage.part_content = `Filesystem fs;
 296                       part_dev = dev } ->
 297                       f dom ~disk ~partno:(i+1) dev fs
 298                   | _ -> ()
 299               ) partitions.Diskimage.parts
 300           | _ -> ()
 301         ) disks;
 302         (* LV filesystems. *)
 303         List.iter (
 304           fun ({Diskimage.lv_dev = dev}, fs) -> f dom dev fs
 305         ) filesystems
 306     ) machines
 307   in
 308
 309   (* Printable name is like "domain:hda" or "domain:hda1". *)
 310   let printable_name machine ?disk ?partno dev =
 311     let m_name = machine.Diskimage.m_name in
 312     (* Get the disk name (eg. "hda") from the domain XML, if
 313      * we have it, otherwise use the device name (eg. for LVM).
 314      *)
 315     let disk_name =
 316       match disk with
 317       | None -> dev#name
 318       | Some disk -> disk.Diskimage.d_name
 319     in
 320     match partno with
 321     | None ->
 322         m_name ^ ":" ^ disk_name
 323     | Some partno ->
 324         m_name ^ ":" ^ disk_name ^ string_of_int partno
 325   in
 326
 327   (* Print stats for each recognized filesystem. *)
 328   let print_stats machine ?disk ?partno dev fs =
 329     let name = printable_name machine ?disk ?partno dev in
 330     printf "%-32s " name;
 331
 332     let {
 333       Diskimage.fs_plugin_id = fs_plugin_id;
 334       fs_blocksize = fs_blocksize;
 335       fs_blocks_total = fs_blocks_total;
 336       fs_is_swap = fs_is_swap;
 337       fs_blocks_reserved = fs_blocks_reserved;
 338       fs_blocks_avail = fs_blocks_avail;
 339       fs_blocks_used = fs_blocks_used;
 340       fs_inodes_total = fs_inodes_total;
 341       fs_inodes_reserved = fs_inodes_reserved;
 342       fs_inodes_avail = fs_inodes_avail;
 343       fs_inodes_used = fs_inodes_used
 344     } = fs in
 345
 346     let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
 347
 348     if fs_is_swap then (
 349       (* Swap partition. *)
 350       if not !human then
 351         printf "%10s                       %s\n"
 352           (Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024))
 353           fs_name
 354       else
 355         printf "%10s                       %s\n"
 356           (printable_size (fs_blocksize *^ fs_blocks_total))
 357           fs_name
 358     ) else (
 359       (* Ordinary filesystem. *)
 360       if not !inodes then (             (* Block display. *)
 361         (* 'df' doesn't count the restricted blocks. *)
 362         let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
 363         let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
 364         let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
 365
 366         if not !human then (            (* Display 1K blocks. *)
 367           printf "%10s %10s %10s %s\n"
 368             (Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024))
 369             (Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024))
 370             (Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024))
 371             fs_name
 372         ) else (                        (* Human-readable blocks. *)
 373           printf "%10s %10s %10s %s\n"
 374             (printable_size (blocks_total *^ fs_blocksize))
 375             (printable_size (fs_blocks_used *^ fs_blocksize))
 376             (printable_size (blocks_avail *^ fs_blocksize))
 377             fs_name
 378         )
 379       ) else (                          (* Inodes display. *)
 380         printf "%10s %10s %10s %s\n"
 381           (Int63.to_string fs_inodes_total)
 382           (Int63.to_string fs_inodes_used)
 383           (Int63.to_string fs_inodes_avail)
 384           fs_name
 385       )
 386     )
 387   in
 388
 389   (* Alternate version of print_stats which writes to a CSV file.
 390    * We ignore the human-readable option because we assume that
 391    * the data will be post-processed by something.
 392    *)
 393   let print_stats_csv machine ?disk ?partno dev fs =
 394     let name = printable_name machine ?disk ?partno dev in
 395
 396     let {
 397       Diskimage.fs_plugin_id = fs_plugin_id;
 398       fs_blocksize = fs_blocksize;
 399       fs_blocks_total = fs_blocks_total;
 400       fs_is_swap = fs_is_swap;
 401       fs_blocks_reserved = fs_blocks_reserved;
 402       fs_blocks_avail = fs_blocks_avail;
 403       fs_blocks_used = fs_blocks_used;
 404       fs_inodes_total = fs_inodes_total;
 405       fs_inodes_reserved = fs_inodes_reserved;
 406       fs_inodes_avail = fs_inodes_avail;
 407       fs_inodes_used = fs_inodes_used
 408     } = fs in
 409
 410     let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
 411
 412     let row =
 413       if fs_is_swap then
 414         (* Swap partition. *)
 415         [ Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024);
 416           ""; "" ]
 417       else (
 418         (* Ordinary filesystem. *)
 419         if not !inodes then (           (* 1K block display. *)
 420           (* 'df' doesn't count the restricted blocks. *)
 421           let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
 422           let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
 423           let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
 424
 425           [ Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024);
 426             Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024);
 427             Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024) ]
 428         ) else (                        (* Inodes display. *)
 429           [ Int63.to_string fs_inodes_total;
 430             Int63.to_string fs_inodes_used;
 431             Int63.to_string fs_inodes_avail ]
 432         )
 433       ) in
 434
 435     let row = name :: row @ [fs_name] in
 436     csv_write row
 437   in
 438
 439   iter_over_filesystems machines
 440     (if not !csv_mode then print_stats else print_stats_csv)