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 Virt_df_gettext.Gettext
  27 open Virt_df
  28
  29 let ( +* ) = Int32.add
  30 let ( -* ) = Int32.sub
  31 let ( ** ) = Int32.mul
  32 let ( /* ) = Int32.div
  33
  34 let ( +^ ) = Int64.add
  35 let ( -^ ) = Int64.sub
  36 let ( *^ ) = Int64.mul
  37 let ( /^ ) = Int64.div
  38
  39 let () =
  40   (* Command line argument parsing. *)
  41   let set_uri = function "" -> uri := None | u -> uri := Some u in
  42
  43   let version () =
  44     printf "virt-df %s\n" (Libvirt_version.version);
  45
  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;
  50     exit 0
  51   in
  52
  53   let test_mode filename = test_files := filename :: !test_files in
  54
  55   let argspec = Arg.align [
  56     "-a", Arg.Set all,
  57       " " ^ s_ "Show all domains (default: only active domains)";
  58     "--all", Arg.Set all,
  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)";
  68     "-h", Arg.Set human,
  69       " " ^ s_ "Print sizes in human-readable format";
  70     "--human-readable", Arg.Set human,
  71       " " ^ s_ "Print sizes in human-readable format";
  72     "-i", Arg.Set inodes,
  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";
  80   ] in
  81
  82   let anon_fun str =
  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
  85
  86 SUMMARY
  87   virt-df [-options]
  88
  89 OPTIONS" in
  90
  91   Arg.parse argspec anon_fun usage_msg;
  92
  93   (* Set up CSV support. *)
  94   let csv_write =
  95     if not !csv_mode then
  96       fun _ -> assert false (* Should never happen. *)
  97     else
  98       match !csv_write with
  99       | None ->
 100           prerr_endline (s_ "CSV is not supported in this build of virt-df");
 101           exit 1
 102       | Some csv_write ->
 103           csv_write stdout
 104   in
 105
 106   (*          name      target   dev_path *)
 107   let doms : (string * (string * string) list) list =
 108     if !test_files = [] then (
 109       let xmls =
 110         (* Connect to the hypervisor. *)
 111         let conn =
 112           let name = !uri in
 113           try C.connect_readonly ?name ()
 114           with
 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");
 120               );
 121               exit 1 in
 122
 123         (* Get the list of active & inactive domains. *)
 124         let doms =
 125           let nr_active_doms = C.num_of_domains conn in
 126           let active_doms =
 127             Array.to_list (C.list_domains conn nr_active_doms) in
 128           let active_doms =
 129             List.map (D.lookup_by_id conn) active_doms in
 130           if not !all then
 131             active_doms
 132           else (
 133             let nr_inactive_doms = C.num_of_defined_domains conn in
 134             let inactive_doms =
 135               Array.to_list (C.list_defined_domains conn nr_inactive_doms) in
 136             let inactive_doms =
 137               List.map (D.lookup_by_name conn) inactive_doms in
 138             active_doms @ inactive_doms
 139           ) in
 140
 141         (* Get their XML. *)
 142         let xmls = List.map D.get_xml_desc doms in
 143
 144         (* Parse the XML. *)
 145         let xmls = List.map Xml.parse_string xmls in
 146
 147         (* Return just the XML documents - everything else will be closed
 148          * and freed including the connection to the hypervisor.
 149          *)
 150         xmls in
 151
 152       (* Grr.. Need to use a library which has XPATH support (or cduce). *)
 153       List.map (
 154         fun xml ->
 155           let nodes, domain_attrs =
 156             match xml with
 157             | Xml.Element ("domain", attrs, children) -> children, attrs
 158             | _ -> failwith (s_ "get_xml_desc didn't return <domain/>") in
 159
 160           (*let domid =
 161             try Some (int_of_string (List.assoc "id" domain_attrs))
 162             with Not_found -> None in*)
 163
 164           let rec loop = function
 165             | [] ->
 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
 171           in
 172           let name = loop nodes in
 173
 174           let devices =
 175             let devices =
 176               List.filter_map (
 177                 function
 178                 | Xml.Element ("devices", _, devices) -> Some devices
 179                 | _ -> None
 180               ) nodes in
 181             List.concat devices in
 182
 183           let rec target_dev_of = function
 184             | [] -> None
 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
 189           in
 190
 191           let rec source_file_of = function
 192             | [] -> None
 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
 197           in
 198
 199           let rec source_dev_of = function
 200             | [] -> None
 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
 205           in
 206
 207           let disks =
 208             List.filter_map (
 209               function
 210               | Xml.Element ("disk", attrs, children) ->
 211                   (*let typ =
 212                     try Some (List.assoc "type" attrs)
 213                     with Not_found -> None in*)
 214                   let device =
 215                     try Some (List.assoc "device" attrs)
 216                     with Not_found -> None in
 217                   let source =
 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
 222
 223                   (* We only care about devices where we have
 224                    * source and target.  Ignore CD-ROM devices.
 225                    *)
 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 *)
 230                   )
 231
 232               | _ -> None
 233             ) devices in
 234
 235           name, disks
 236       ) xmls
 237     ) 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
 241        * from these.
 242        *)
 243       List.map (
 244         fun filename ->
 245           filename, ["hda", filename]
 246       ) !test_files
 247     ) in
 248
 249   (* Convert these to Diskimage library 'machine's. *)
 250   let machines = List.filter_map (
 251     fun (name, disks) ->
 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);
 255         None
 256   ) doms in
 257
 258   (* Scan them. *)
 259   let machines = List.map Diskimage.scan_machine machines in
 260
 261   (*----------------------------------------------------------------------*)
 262   (* Now print the results. *)
 263
 264   (* Print the title. *)
 265   let () =
 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")
 274     else
 275       csv_write [ "Filesystem"; total; used; avail; "Type" ] in
 276
 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.)
 282     else
 283       sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.)
 284   in
 285
 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 ->
 290         unit) =
 291     List.iter (
 292       fun ({ Diskimage.m_disks = disks;
 293              m_lv_filesystems = filesystems } as dom) ->
 294         (* Ordinary filesystems found on disks & partitions. *)
 295         List.iter (
 296           function
 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) ->
 300               List.iteri (
 301                 fun i ->
 302                   function
 303                   | { Diskimage.part_content = `Filesystem fs;
 304                       part_dev = dev } ->
 305                       f dom ~disk ~partno:(i+1) dev fs
 306                   | _ -> ()
 307               ) partitions.Diskimage.parts
 308           | _ -> ()
 309         ) disks;
 310         (* LV filesystems. *)
 311         List.iter (
 312           fun ({Diskimage.lv_dev = dev}, fs) -> f dom dev fs
 313         ) filesystems
 314     ) machines
 315   in
 316
 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).
 322      *)
 323     let disk_name =
 324       match disk with
 325       | None -> dev#name
 326       | Some disk -> disk.Diskimage.d_name
 327     in
 328     match partno with
 329     | None ->
 330         m_name ^ ":" ^ disk_name
 331     | Some partno ->
 332         m_name ^ ":" ^ disk_name ^ string_of_int partno
 333   in
 334
 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;
 339
 340     let {
 341       Diskimage.fs_plugin_id = fs_plugin_id;
 342       fs_blocksize = fs_blocksize;
 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
 352     } = fs in
 353     let fs_blocksize = Int64.of_int fs_blocksize in
 354
 355     let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
 356
 357     if fs_is_swap then (
 358       (* Swap partition. *)
 359       if not !human then
 360         printf "%10Ld                       %s\n"
 361           (fs_blocksize *^ fs_blocks_total /^ 1024L) fs_name
 362       else
 363         printf "%10s                       %s\n"
 364           (printable_size (fs_blocksize *^ fs_blocks_total)) fs_name
 365     ) else (
 366       (* Ordinary filesystem. *)
 367       if not !inodes then (             (* Block display. *)
 368         (* 'df' doesn't count the restricted blocks. *)
 369         let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
 370         let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
 371         let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in
 372
 373         if not !human then (            (* Display 1K blocks. *)
 374           printf "%10Ld %10Ld %10Ld %s\n"
 375             (blocks_total *^ fs_blocksize /^ 1024L)
 376             (fs_blocks_used *^ fs_blocksize /^ 1024L)
 377             (blocks_avail *^ fs_blocksize /^ 1024L)
 378             fs_name
 379         ) else (                        (* Human-readable blocks. *)
 380           printf "%10s %10s %10s %s\n"
 381             (printable_size (blocks_total *^ fs_blocksize))
 382             (printable_size (fs_blocks_used *^ fs_blocksize))
 383             (printable_size (blocks_avail *^ fs_blocksize))
 384             fs_name
 385         )
 386       ) else (                          (* Inodes display. *)
 387         printf "%10Ld %10Ld %10Ld %s\n"
 388           fs_inodes_total fs_inodes_used fs_inodes_avail
 389           fs_name
 390       )
 391     )
 392   in
 393
 394   (* Alternate version of print_stats which writes to a CSV file.
 395    * We ignore the human-readable option because we assume that
 396    * the data will be post-processed by something.
 397    *)
 398   let print_stats_csv machine ?disk ?partno dev fs =
 399     let name = printable_name machine ?disk ?partno dev in
 400
 401     let {
 402       Diskimage.fs_plugin_id = fs_plugin_id;
 403       fs_blocksize = fs_blocksize;
 404       fs_blocks_total = fs_blocks_total;
 405       fs_is_swap = fs_is_swap;
 406       fs_blocks_reserved = fs_blocks_reserved;
 407       fs_blocks_avail = fs_blocks_avail;
 408       fs_blocks_used = fs_blocks_used;
 409       fs_inodes_total = fs_inodes_total;
 410       fs_inodes_reserved = fs_inodes_reserved;
 411       fs_inodes_avail = fs_inodes_avail;
 412       fs_inodes_used = fs_inodes_used
 413     } = fs in
 414     let fs_blocksize = Int64.of_int fs_blocksize in
 415
 416     let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
 417
 418     let row =
 419       if fs_is_swap then
 420         (* Swap partition. *)
 421         [ Int64.to_string (fs_blocksize *^ fs_blocks_total /^ 1024L);
 422           ""; "" ]
 423       else (
 424         (* Ordinary filesystem. *)
 425         if not !inodes then (           (* 1K block display. *)
 426           (* 'df' doesn't count the restricted blocks. *)
 427           let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
 428           let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
 429           let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in
 430
 431           [ Int64.to_string (blocks_total *^ fs_blocksize /^ 1024L);
 432             Int64.to_string (fs_blocks_used *^ fs_blocksize /^ 1024L);
 433             Int64.to_string (blocks_avail *^ fs_blocksize /^ 1024L) ]
 434         ) else (                        (* Inodes display. *)
 435           [ Int64.to_string fs_inodes_total;
 436             Int64.to_string fs_inodes_used;
 437             Int64.to_string fs_inodes_avail ]
 438         )
 439       ) in
 440
 441     let row = name :: row @ [fs_name] in
 442     csv_write row
 443   in
 444
 445   iter_over_filesystems machines
 446     (if not !csv_mode then print_stats else print_stats_csv)