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 disk_block_size = ~^512
  32
  33 (* A libvirt-backed block device. *)
  34 class libvirt_device dom name path blocksize =
  35   (* Size is never really used. *)
  36   let size = ~^0 in
  37 object (self)
  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);
  44     str
  45   method size = size
  46   method name = name
  47   method blocksize = blocksize
  48   method map_block _ = []
  49   method contiguous offset = size -^ offset
  50   method close () = ()
  51   initializer
  52     (* Check that access is possible - throws a virterror if not. *)
  53     D.block_peek dom path 0L 0 "" 0
  54 end
  55
  56 let () =
  57   (* Command line argument parsing. *)
  58   let set_uri = function "" -> uri := None | u -> uri := Some u in
  59
  60   let version () =
  61     printf "virt-df %s\n" Virt_df_version.version;
  62
  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;
  67     exit 0
  68   in
  69
  70   let test_mode filename = test_files := filename :: !test_files in
  71
  72   let argspec = Arg.align [
  73     "-a", Arg.Set all,
  74       " " ^ s_ "Show all domains (default: only active domains)";
  75     "--all", Arg.Set all,
  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)";
  85     "-h", Arg.Set human,
  86       " " ^ s_ "Print sizes in human-readable format";
  87     "--human-readable", Arg.Set human,
  88       " " ^ s_ "Print sizes in human-readable format";
  89     "-i", Arg.Set inodes,
  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";
  97   ] in
  98
  99   let anon_fun str =
 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
 102
 103 SUMMARY
 104   virt-df [-options]
 105
 106 OPTIONS" in
 107
 108   Arg.parse argspec anon_fun usage_msg;
 109
 110   (* Set up CSV support. *)
 111   let csv_write =
 112     if not !csv_mode then
 113       fun _ -> assert false (* Should never happen. *)
 114     else
 115       match !csv_write with
 116       | None ->
 117           prerr_endline (s_ "CSV is not supported in this build of virt-df");
 118           exit 1
 119       | Some csv_write ->
 120           csv_write stdout
 121   in
 122
 123   let doms =
 124     if !test_files = [] then (
 125       let xmls =
 126         (* Connect to the hypervisor. *)
 127         let conn =
 128           let name = !uri in
 129           try C.connect ?name ()
 130           with
 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");
 136               );
 137               exit 1 in
 138
 139         let xmls =
 140           try
 141             (* Get the list of active & inactive domains. *)
 142             let doms =
 143               let nr_active_doms = C.num_of_domains conn in
 144               let active_doms =
 145                 Array.to_list (C.list_domains conn nr_active_doms) in
 146               let active_doms =
 147                 List.map (D.lookup_by_id conn) active_doms in
 148               if not !all then
 149                 active_doms
 150               else (
 151                 let nr_inactive_doms = C.num_of_defined_domains conn in
 152                 let inactive_doms =
 153                   Array.to_list
 154                     (C.list_defined_domains conn nr_inactive_doms) in
 155                 let inactive_doms =
 156                   List.map (D.lookup_by_name conn) inactive_doms in
 157                 active_doms @ inactive_doms
 158               ) in
 159
 160             (* Get their XML. *)
 161             let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in
 162
 163             (* Parse the XML. *)
 164             let xmls = List.map (fun (dom, xml) ->
 165                                    dom, Xml.parse_string xml) xmls in
 166
 167             xmls
 168           with
 169             Libvirt.Virterror err ->
 170               prerr_endline (Libvirt.Virterror.to_string err);
 171               exit 1 in
 172         xmls in
 173
 174       (* Grr.. Need to use a library which has XPATH support (or cduce). *)
 175       List.map (
 176         fun (dom, xml) ->
 177           let nodes, domain_attrs =
 178             match xml with
 179             | Xml.Element ("domain", attrs, children) -> children, attrs
 180             | _ -> failwith (s_ "get_xml_desc didn't return <domain/>") in
 181
 182           (*let domid =
 183             try Some (int_of_string (List.assoc "id" domain_attrs))
 184             with Not_found -> None in*)
 185
 186           let rec loop = function
 187             | [] ->
 188                 failwith (s_ "get_xml_desc returned no <name> node in XML")
 189             | Xml.Element ("name", _, [Xml.PCData name]) :: _ -> name
 190             | Xml.Element ("name", _, _) :: _ ->
 191                 failwith (s_ "get_xml_desc returned strange <name> node")
 192             | _ :: rest -> loop rest
 193           in
 194           let name = loop nodes in
 195
 196           let devices =
 197             let devices =
 198               List.filter_map (
 199                 function
 200                 | Xml.Element ("devices", _, devices) -> Some devices
 201                 | _ -> None
 202               ) nodes in
 203             List.concat devices in
 204
 205           let rec target_dev_of = function
 206             | [] -> None
 207             | Xml.Element ("target", attrs, _) :: rest ->
 208                 (try Some (List.assoc "dev" attrs)
 209                  with Not_found -> target_dev_of rest)
 210             | _ :: rest -> target_dev_of rest
 211           in
 212
 213           let rec source_file_of = function
 214             | [] -> None
 215             | Xml.Element ("source", attrs, _) :: rest ->
 216                 (try Some (List.assoc "file" attrs)
 217                  with Not_found -> source_file_of rest)
 218             | _ :: rest -> source_file_of rest
 219           in
 220
 221           let rec source_dev_of = function
 222             | [] -> None
 223             | Xml.Element ("source", attrs, _) :: rest ->
 224                 (try Some (List.assoc "dev" attrs)
 225                  with Not_found -> source_dev_of rest)
 226             | _ :: rest -> source_dev_of rest
 227           in
 228
 229           let disks =
 230             List.filter_map (
 231               function
 232               | Xml.Element ("disk", attrs, children) ->
 233                   (*let typ =
 234                     try Some (List.assoc "type" attrs)
 235                     with Not_found -> None in*)
 236                   let device =
 237                     try Some (List.assoc "device" attrs)
 238                     with Not_found -> None in
 239                   let source =
 240                     match source_file_of children with
 241                     | (Some _) as source -> source
 242                     | None -> source_dev_of children in
 243                   let target = target_dev_of children in
 244
 245                   (* We only care about devices where we have
 246                    * source and target.  Ignore CD-ROM devices.
 247                    *)
 248                   (match source, target, device with
 249                    | _, _, Some "cdrom" -> None (* ignore CD-ROMs *)
 250                    | Some source, Some target, _ -> Some (target, source)
 251                    | _ -> None (* ignore anything else *)
 252                   )
 253
 254               | _ -> None
 255             ) devices in
 256
 257           let disks = List.filter_map (
 258             fun (name, path) ->
 259               try Some (name, new libvirt_device dom name path disk_block_size)
 260               with Libvirt.Virterror err ->
 261                 eprintf "%s: %s\n" name (Libvirt.Virterror.to_string err);
 262                 None
 263           ) disks in
 264
 265           name, disks
 266       ) xmls
 267     ) else (
 268       (* In test mode (-t option) the user can pass one or more
 269        * block devices or filenames (containing partitions/filesystems/etc)
 270        * which we use for testing virt-df itself.  We create fake domains
 271        * from these.
 272        *)
 273       List.filter_map (
 274         fun filename ->
 275           try Some (filename,
 276                     ["hda",
 277                      new Diskimage.block_device filename disk_block_size])
 278           with Unix.Unix_error (err, func, param) ->
 279             eprintf "%s:%s: %s\n" func param (Unix.error_message err);
 280             None
 281       ) !test_files
 282     ) in
 283
 284   (* Convert these to Diskimage library 'machine's. *)
 285   let machines = List.map (
 286     fun (name, disks) -> Diskimage.open_machine_from_devices name disks
 287   ) doms in
 288
 289   (* Scan them. *)
 290   let machines = List.map Diskimage.scan_machine machines in
 291
 292   (*----------------------------------------------------------------------*)
 293   (* Now print the results. *)
 294
 295   (* Print the title. *)
 296   let () =
 297     let total, used, avail =
 298       match !inodes, !human with
 299       | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available"
 300       | false, true -> s_ "Size", s_ "Used", s_ "Available"
 301       | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in
 302     if not !csv_mode then
 303       printf "%-32s %10s %10s %10s %s\n%!"
 304         (s_ "Filesystem") total used avail (s_ "Type")
 305     else
 306       csv_write [ "Filesystem"; total; used; avail; "Type" ] in
 307
 308   let printable_size bytes =
 309     if bytes < ~^1024 *^ ~^1024 then
 310       sprintf "%s bytes" (Int63.to_string bytes)
 311     else if bytes < ~^1024 *^ ~^1024 *^ ~^1024 then
 312       sprintf "%.1f MiB" (Int63.to_float (bytes /^ ~^1024) /. 1024.)
 313     else
 314       sprintf "%.1f GiB" (Int63.to_float (bytes /^ ~^1024 /^ ~^1024) /. 1024.)
 315   in
 316
 317   (* HOF to iterate over filesystems. *)
 318   let iter_over_filesystems machines
 319       (f : Diskimage.machine -> ?disk:Diskimage.disk -> ?partno:int ->
 320         Diskimage.device -> Diskimage.filesystem ->
 321         unit) =
 322     List.iter (
 323       fun ({ Diskimage.m_disks = disks;
 324              m_lv_filesystems = filesystems } as dom) ->
 325         (* Ordinary filesystems found on disks & partitions. *)
 326         List.iter (
 327           function
 328           | ({ Diskimage.d_content = `Filesystem fs; d_dev = dev } as disk) ->
 329               f dom ~disk (dev :> Diskimage.device) fs
 330           | ({ Diskimage.d_content = `Partitions partitions } as disk) ->
 331               List.iteri (
 332                 fun i ->
 333                   function
 334                   | { Diskimage.part_content = `Filesystem fs;
 335                       part_dev = dev } ->
 336                       f dom ~disk ~partno:(i+1) dev fs
 337                   | _ -> ()
 338               ) partitions.Diskimage.parts
 339           | _ -> ()
 340         ) disks;
 341         (* LV filesystems. *)
 342         List.iter (
 343           fun ({Diskimage.lv_dev = dev}, fs) -> f dom dev fs
 344         ) filesystems
 345     ) machines
 346   in
 347
 348   (* Printable name is like "domain:hda" or "domain:hda1". *)
 349   let printable_name machine ?disk ?partno dev =
 350     let m_name = machine.Diskimage.m_name in
 351     (* Get the disk name (eg. "hda") from the domain XML, if
 352      * we have it, otherwise use the device name (eg. for LVM).
 353      *)
 354     let disk_name =
 355       match disk with
 356       | None -> dev#name
 357       | Some disk -> disk.Diskimage.d_name
 358     in
 359     match partno with
 360     | None ->
 361         m_name ^ ":" ^ disk_name
 362     | Some partno ->
 363         m_name ^ ":" ^ disk_name ^ string_of_int partno
 364   in
 365
 366   (* Print stats for each recognized filesystem. *)
 367   let print_stats machine ?disk ?partno dev fs =
 368     let name = printable_name machine ?disk ?partno dev in
 369     printf "%-32s " name;
 370
 371     let {
 372       Diskimage.fs_blocksize = fs_blocksize;
 373       fs_blocks_total = fs_blocks_total;
 374       fs_is_swap = fs_is_swap;
 375       fs_blocks_reserved = fs_blocks_reserved;
 376       fs_blocks_avail = fs_blocks_avail;
 377       fs_blocks_used = fs_blocks_used;
 378       fs_inodes_total = fs_inodes_total;
 379       fs_inodes_reserved = fs_inodes_reserved;
 380       fs_inodes_avail = fs_inodes_avail;
 381       fs_inodes_used = fs_inodes_used
 382     } = fs in
 383
 384     let fs_name = Diskimage.name_of_filesystem fs in
 385
 386     if fs_is_swap then (
 387       (* Swap partition. *)
 388       if not !human then
 389         printf "%10s                       %s\n"
 390           (Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024))
 391           fs_name
 392       else
 393         printf "%10s                       %s\n"
 394           (printable_size (fs_blocksize *^ fs_blocks_total))
 395           fs_name
 396     ) else (
 397       (* Ordinary filesystem. *)
 398       if not !inodes then (             (* Block display. *)
 399         (* 'df' doesn't count the restricted blocks. *)
 400         let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
 401         let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
 402         let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
 403
 404         if not !human then (            (* Display 1K blocks. *)
 405           printf "%10s %10s %10s %s\n"
 406             (Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024))
 407             (Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024))
 408             (Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024))
 409             fs_name
 410         ) else (                        (* Human-readable blocks. *)
 411           printf "%10s %10s %10s %s\n"
 412             (printable_size (blocks_total *^ fs_blocksize))
 413             (printable_size (fs_blocks_used *^ fs_blocksize))
 414             (printable_size (blocks_avail *^ fs_blocksize))
 415             fs_name
 416         )
 417       ) else (                          (* Inodes display. *)
 418         printf "%10s %10s %10s %s\n"
 419           (Int63.to_string fs_inodes_total)
 420           (Int63.to_string fs_inodes_used)
 421           (Int63.to_string fs_inodes_avail)
 422           fs_name
 423       )
 424     )
 425   in
 426
 427   (* Alternate version of print_stats which writes to a CSV file.
 428    * We ignore the human-readable option because we assume that
 429    * the data will be post-processed by something.
 430    *)
 431   let print_stats_csv machine ?disk ?partno dev fs =
 432     let name = printable_name machine ?disk ?partno dev in
 433
 434     let {
 435       Diskimage.fs_blocksize = fs_blocksize;
 436       fs_blocks_total = fs_blocks_total;
 437       fs_is_swap = fs_is_swap;
 438       fs_blocks_reserved = fs_blocks_reserved;
 439       fs_blocks_avail = fs_blocks_avail;
 440       fs_blocks_used = fs_blocks_used;
 441       fs_inodes_total = fs_inodes_total;
 442       fs_inodes_reserved = fs_inodes_reserved;
 443       fs_inodes_avail = fs_inodes_avail;
 444       fs_inodes_used = fs_inodes_used
 445     } = fs in
 446
 447     let fs_name = Diskimage.name_of_filesystem fs in
 448
 449     let row =
 450       if fs_is_swap then
 451         (* Swap partition. *)
 452         [ Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024);
 453           ""; "" ]
 454       else (
 455         (* Ordinary filesystem. *)
 456         if not !inodes then (           (* 1K block display. *)
 457           (* 'df' doesn't count the restricted blocks. *)
 458           let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
 459           let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
 460           let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
 461
 462           [ Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024);
 463             Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024);
 464             Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024) ]
 465         ) else (                        (* Inodes display. *)
 466           [ Int63.to_string fs_inodes_total;
 467             Int63.to_string fs_inodes_used;
 468             Int63.to_string fs_inodes_avail ]
 469         )
 470       ) in
 471
 472     let row = name :: row @ [fs_name] in
 473     csv_write row
 474   in
 475
 476   iter_over_filesystems machines
 477     (if not !csv_mode then print_stats else print_stats_csv)