X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=virt-df%2Fvirt_df_main.ml;h=57d002a719eb57c63d6bbfaca4ef5a89996284a8;hb=0f681c012fd8eac3807f038c234969969fa1339f;hp=65d1f2fc76afb401ee3b00394744de0abc2110ab;hpb=49ec200e1391ff462fce459f1c9159a53883badf;p=virt-df.git diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml index 65d1f2f..57d002a 100644 --- a/virt-df/virt_df_main.ml +++ b/virt-df/virt_df_main.ml @@ -19,14 +19,40 @@ open Printf open ExtList -open Unix module C = Libvirt.Connect module D = Libvirt.Domain +open Int63.Operators + open Virt_df_gettext.Gettext open Virt_df +let disk_block_size = ~^512 + +(* A libvirt-backed block device. *) +class libvirt_device dom name path blocksize = + (* Size is never really used. *) + let size = ~^0 in +object (self) + inherit Diskimage.device + method read offset len = + let offset = Int63.to_int64 offset in + let len = Int63.to_int len in + let str = String.make len '\000' in + ignore (D.block_peek dom path offset len str 0); + str + method size = size + method name = name + method blocksize = blocksize + method map_block _ = [] + method contiguous offset = size -^ offset + method close () = () + initializer + (* Check that access is possible - throws a virterror if not. *) + D.block_peek dom path 0L 0 "" 0 +end + let () = (* Command line argument parsing. *) let set_uri = function "" -> uri := None | u -> uri := Some u in @@ -41,9 +67,7 @@ let () = exit 0 in - let test_mode filename = - test_files := filename :: !test_files - in + let test_mode filename = test_files := filename :: !test_files in let argspec = Arg.align [ "-a", Arg.Set all, @@ -51,10 +75,12 @@ let () = "--all", Arg.Set all, " " ^ s_ "Show all domains (default: only active domains)"; "-c", Arg.String set_uri, - "uri " ^ s_ "Connect to URI (default: Xen)"; + "uri " ^ s_ "Connect to URI"; "--connect", Arg.String set_uri, - "uri " ^ s_ "Connect to URI (default: Xen)"; - "--debug", Arg.Set debug, + "uri " ^ s_ "Connect to URI"; + "--csv", Arg.Set csv_mode, + " " ^ s_ "Write results in CSV format"; + "--debug", Arg.Set Diskimage.debug, " " ^ s_ "Debug mode (default: false)"; "-h", Arg.Set human, " " ^ s_ "Print sizes in human-readable format"; @@ -81,7 +107,20 @@ OPTIONS" in Arg.parse argspec anon_fun usage_msg; - let doms : domain list = + (* Set up CSV support. *) + let csv_write = + if not !csv_mode then + fun _ -> assert false (* Should never happen. *) + else + match !csv_write with + | None -> + prerr_endline (s_ "CSV is not supported in this build of virt-df"); + exit 1 + | Some csv_write -> + csv_write stdout + in + + let doms = if !test_files = [] then ( let xmls = (* Connect to the hypervisor. *) @@ -92,7 +131,7 @@ OPTIONS" in Libvirt.Virterror err -> prerr_endline (Libvirt.Virterror.to_string err); (* If non-root and no explicit connection URI, print a warning. *) - if geteuid () <> 0 && name = None then ( + if Unix.geteuid () <> 0 && name = None then ( print_endline (s_ "NB: If you want to monitor a local Xen hypervisor, you usually need to be root"); ); exit 1 in @@ -116,27 +155,25 @@ OPTIONS" in ) in (* Get their XML. *) - let xmls = List.map D.get_xml_desc doms in + let xmls = List.map (fun dom -> dom, D.get_xml_desc dom) doms in (* Parse the XML. *) - let xmls = List.map Xml.parse_string xmls in + let xmls = List.map (fun (dom, xml) -> + dom, Xml.parse_string xml) xmls in - (* Return just the XML documents - everything else will be closed - * and freed including the connection to the hypervisor. - *) xmls in (* Grr.. Need to use a library which has XPATH support (or cduce). *) List.map ( - fun xml -> + fun (dom, xml) -> let nodes, domain_attrs = match xml with | Xml.Element ("domain", attrs, children) -> children, attrs | _ -> failwith (s_ "get_xml_desc didn't return ") in - let domid = + (*let domid = try Some (int_of_string (List.assoc "id" domain_attrs)) - with Not_found -> None in + with Not_found -> None in*) let rec loop = function | [] -> @@ -185,9 +222,9 @@ OPTIONS" in List.filter_map ( function | Xml.Element ("disk", attrs, children) -> - let typ = + (*let typ = try Some (List.assoc "type" attrs) - with Not_found -> None in + with Not_found -> None in*) let device = try Some (List.assoc "device" attrs) with Not_found -> None in @@ -201,32 +238,23 @@ OPTIONS" in * source and target. Ignore CD-ROM devices. *) (match source, target, device with - | _, _, Some "cdrom" -> None (* ignore *) - | Some source, Some target, Some device -> - (* Try to create a 'device' object for this - * device. If it fails, print a warning - * and ignore the device. - *) - (try - let dev = new block_device source in - Some { - d_type = typ; d_device = device; - d_source = source; d_target = target; - d_dev = dev; d_content = `Unknown - } - with - Unix_error (err, func, param) -> - eprintf "%s:%s: %s" func param (error_message err); - None - ) + | _, _, Some "cdrom" -> None (* ignore CD-ROMs *) + | Some source, Some target, _ -> Some (target, source) | _ -> None (* ignore anything else *) ) | _ -> None ) devices in - { dom_name = name; dom_id = domid; - dom_disks = disks; dom_lv_filesystems = [] } + let disks = List.filter_map ( + fun (name, path) -> + try Some (name, new libvirt_device dom name path disk_block_size) + with Libvirt.Virterror err -> + eprintf "%s: %s\n" name (Libvirt.Virterror.to_string err); + None + ) disks in + + name, disks ) xmls ) else ( (* In test mode (-t option) the user can pass one or more @@ -234,255 +262,208 @@ OPTIONS" in * which we use for testing virt-df itself. We create fake domains * from these. *) - List.map ( + List.filter_map ( fun filename -> - { - dom_name = filename; dom_id = None; - dom_disks = [ - { - d_type = Some "disk"; d_device = "disk"; - d_source = filename; d_target = "hda"; - d_dev = new block_device filename; d_content = `Unknown; - } - ]; - dom_lv_filesystems = [] - } + try Some (filename, + ["hda", + new Diskimage.block_device filename disk_block_size]) + with Unix.Unix_error (err, func, param) -> + eprintf "%s:%s: %s\n" func param (Unix.error_message err); + None ) !test_files ) in - (* HOF to map over disks. *) - let map_over_disks doms f = - List.map ( - fun ({ dom_disks = disks } as dom) -> - let disks = List.map f disks in - { dom with dom_disks = disks } - ) doms - in - - (* 'doms' is our list of domains and their guest block devices, and - * we've successfully opened each block device. Now probe them - * to find out what they contain. - *) - let doms = map_over_disks doms ( - fun ({ d_dev = dev } as disk) -> - (* See if it is partitioned first. *) - let parts = probe_for_partitions dev in - match parts with - | Some parts -> - { disk with d_content = `Partitions parts } - | None -> - (* Not partitioned. Does it contain a filesystem? *) - let fs = probe_for_filesystem dev in - match fs with - | Some fs -> - { disk with d_content = `Filesystem fs } - | None -> - (* Not partitioned, no filesystem, is it a PV? *) - let pv = probe_for_pv dev in - match pv with - | Some lvm_name -> - { disk with d_content = `PhysicalVolume lvm_name } - | None -> - disk (* Spare/unknown. *) - ) in - - (* Now we have either detected partitions or a filesystem on each - * physical device (or perhaps neither). See what is on those - * partitions. - *) - let doms = map_over_disks doms ( - function - | ({ d_dev = dev; d_content = `Partitions parts } as disk) -> - let ps = List.map ( - fun p -> - if p.part_status = Bootable || p.part_status = Nonbootable then ( - let fs = probe_for_filesystem p.part_dev in - match fs with - | Some fs -> - { p with part_content = `Filesystem fs } - | None -> - (* Is it a PV? *) - let pv = probe_for_pv p.part_dev in - match pv with - | Some lvm_name -> - { p with part_content = `PhysicalVolume lvm_name } - | None -> - p (* Spare/unknown. *) - ) else p - ) parts.parts in - let parts = { parts with parts = ps } in - { disk with d_content = `Partitions parts } - | disk -> disk - ) in - - (* LVM filesystem detection - * - * For each domain, look for all disks/partitions which have been - * identified as PVs and pass those back to the respective LVM - * plugin for LV detection. - * - * (Note - a two-stage process because an LV can be spread over - * several PVs, so we have to detect all PVs belonging to a - * domain first). - * - * XXX To deal with RAID (ie. md devices) we will need to loop - * around here because RAID is like LVM except that they normally - * present as block devices which can be used by LVM. - *) - (* First: LV detection. *) - let doms = List.map ( - fun ({ dom_disks = disks } as dom) -> - (* Find all physical volumes, can be disks or partitions. *) - let pvs_on_disks = List.filter_map ( - function - | { d_dev = d_dev; - d_content = `PhysicalVolume pv } -> Some (pv, d_dev) - | _ -> None - ) disks in - let pvs_on_partitions = List.map ( - function - | { d_content = `Partitions { parts = parts } } -> - List.filter_map ( - function - | { part_dev = part_dev; - part_content = `PhysicalVolume pv } -> - Some (pv, part_dev) - | _ -> None - ) parts - | _ -> [] - ) disks in - let lvs = List.concat (pvs_on_disks :: pvs_on_partitions) in - dom, lvs + (* Convert these to Diskimage library 'machine's. *) + let machines = List.map ( + fun (name, disks) -> Diskimage.open_machine_from_devices name disks ) doms in - (* Second: filesystem on LV detection. *) - let doms = List.map ( - fun (dom, lvs) -> - (* Group the LVs by plug-in type. *) - let cmp (a,_) (b,_) = compare a b in - let lvs = List.sort ~cmp lvs in - let lvs = group_by lvs in + (* Scan them. *) + let machines = List.map Diskimage.scan_machine machines in - let lvs = - List.map (fun (pv, devs) -> list_lvs pv.lvm_plugin_id devs) lvs in - let lvs = List.concat lvs in + (*----------------------------------------------------------------------*) + (* Now print the results. *) - (* lvs is a list of potential LV devices. Now run them through the - * probes to see if any contain filesystems. - *) - let filesystems = - List.filter_map ( - fun ({ lv_dev = dev } as lv) -> - match probe_for_filesystem dev with - | Some fs -> Some (lv, fs) - | None -> None - ) lvs in - - { dom with dom_lv_filesystems = filesystems } - ) doms in - - (* Now print the results. - * - * Print the title. - *) + (* Print the title. *) let () = let total, used, avail = match !inodes, !human with | false, false -> s_ "1K-blocks", s_ "Used", s_ "Available" | false, true -> s_ "Size", s_ "Used", s_ "Available" | true, _ -> s_ "Inodes", s_ "IUse", s_ "IFree" in - printf "%-20s %10s %10s %10s %s\n%!" - (s_ "Filesystem") total used avail (s_ "Type") in + if not !csv_mode then + printf "%-32s %10s %10s %10s %s\n%!" + (s_ "Filesystem") total used avail (s_ "Type") + else + csv_write [ "Filesystem"; total; used; avail; "Type" ] in let printable_size bytes = - if bytes < 1024L *^ 1024L then - sprintf "%Ld bytes" bytes - else if bytes < 1024L *^ 1024L *^ 1024L then - sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.) + if bytes < ~^1024 *^ ~^1024 then + sprintf "%s bytes" (Int63.to_string bytes) + else if bytes < ~^1024 *^ ~^1024 *^ ~^1024 then + sprintf "%.1f MiB" (Int63.to_float (bytes /^ ~^1024) /. 1024.) else - sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.) + sprintf "%.1f GiB" (Int63.to_float (bytes /^ ~^1024 /^ ~^1024) /. 1024.) in (* HOF to iterate over filesystems. *) - let iter_over_filesystems doms - (f : domain -> ?disk:disk -> ?partno:int -> device -> filesystem -> + let iter_over_filesystems machines + (f : Diskimage.machine -> ?disk:Diskimage.disk -> ?partno:int -> + Diskimage.device -> Diskimage.filesystem -> unit) = List.iter ( - fun ({ dom_disks = disks; dom_lv_filesystems = filesystems } as dom) -> + fun ({ Diskimage.m_disks = disks; + m_lv_filesystems = filesystems } as dom) -> (* Ordinary filesystems found on disks & partitions. *) List.iter ( function - | ({ d_content = `Filesystem fs; d_dev = dev } as disk) -> - f dom ~disk dev fs - | ({ d_content = `Partitions partitions } as disk) -> + | ({ Diskimage.d_content = `Filesystem fs; d_dev = dev } as disk) -> + f dom ~disk (dev :> Diskimage.device) fs + | ({ Diskimage.d_content = `Partitions partitions } as disk) -> List.iteri ( fun i -> function - | { part_content = `Filesystem fs; part_dev = dev } -> + | { Diskimage.part_content = `Filesystem fs; + part_dev = dev } -> f dom ~disk ~partno:(i+1) dev fs | _ -> () - ) partitions.parts + ) partitions.Diskimage.parts | _ -> () ) disks; (* LV filesystems. *) - List.iter (fun ({lv_dev = dev}, fs) -> f dom dev fs) filesystems - ) doms + List.iter ( + fun ({Diskimage.lv_dev = dev}, fs) -> f dom dev fs + ) filesystems + ) machines in - (* Print stats for each recognized filesystem. *) - let print_stats dom ?disk ?partno dev fs = - (* Printable name is like "domain:hda" or "domain:hda1". *) - let name = - let dom_name = dom.dom_name in - (* Get the disk name (eg. "hda") from the domain XML, if - * we have it, otherwise use the device name (eg. for LVM). - *) - let disk_name = - match disk with - | None -> dev#name - | Some disk -> disk.d_target - in - match partno with - | None -> - dom_name ^ ":" ^ disk_name - | Some partno -> - dom_name ^ ":" ^ disk_name ^ string_of_int partno in - printf "%-20s " name; + (* Printable name is like "domain:hda" or "domain:hda1". *) + let printable_name machine ?disk ?partno dev = + let m_name = machine.Diskimage.m_name in + (* Get the disk name (eg. "hda") from the domain XML, if + * we have it, otherwise use the device name (eg. for LVM). + *) + let disk_name = + match disk with + | None -> dev#name + | Some disk -> disk.Diskimage.d_name + in + match partno with + | None -> + m_name ^ ":" ^ disk_name + | Some partno -> + m_name ^ ":" ^ disk_name ^ string_of_int partno + in - if fs.fs_is_swap then ( + (* Print stats for each recognized filesystem. *) + let print_stats machine ?disk ?partno dev fs = + let name = printable_name machine ?disk ?partno dev in + printf "%-32s " name; + + let { + Diskimage.fs_blocksize = fs_blocksize; + fs_blocks_total = fs_blocks_total; + fs_is_swap = fs_is_swap; + fs_blocks_reserved = fs_blocks_reserved; + fs_blocks_avail = fs_blocks_avail; + fs_blocks_used = fs_blocks_used; + fs_inodes_total = fs_inodes_total; + fs_inodes_reserved = fs_inodes_reserved; + fs_inodes_avail = fs_inodes_avail; + fs_inodes_used = fs_inodes_used + } = fs in + + let fs_name = Diskimage.name_of_filesystem fs in + + if fs_is_swap then ( (* Swap partition. *) if not !human then - printf "%10Ld %s\n" - (fs.fs_block_size *^ fs.fs_blocks_total /^ 1024L) fs.fs_name + printf "%10s %s\n" + (Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024)) + fs_name else printf "%10s %s\n" - (printable_size (fs.fs_block_size *^ fs.fs_blocks_total)) fs.fs_name + (printable_size (fs_blocksize *^ fs_blocks_total)) + fs_name ) else ( (* Ordinary filesystem. *) if not !inodes then ( (* Block display. *) (* 'df' doesn't count the restricted blocks. *) - let blocks_total = fs.fs_blocks_total -^ fs.fs_blocks_reserved in - let blocks_avail = fs.fs_blocks_avail -^ fs.fs_blocks_reserved in - let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in + let blocks_total = fs_blocks_total -^ fs_blocks_reserved in + let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in + let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in if not !human then ( (* Display 1K blocks. *) - printf "%10Ld %10Ld %10Ld %s\n" - (blocks_total *^ fs.fs_block_size /^ 1024L) - (fs.fs_blocks_used *^ fs.fs_block_size /^ 1024L) - (blocks_avail *^ fs.fs_block_size /^ 1024L) - fs.fs_name + printf "%10s %10s %10s %s\n" + (Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024)) + (Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024)) + (Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024)) + fs_name ) else ( (* Human-readable blocks. *) printf "%10s %10s %10s %s\n" - (printable_size (blocks_total *^ fs.fs_block_size)) - (printable_size (fs.fs_blocks_used *^ fs.fs_block_size)) - (printable_size (blocks_avail *^ fs.fs_block_size)) - fs.fs_name + (printable_size (blocks_total *^ fs_blocksize)) + (printable_size (fs_blocks_used *^ fs_blocksize)) + (printable_size (blocks_avail *^ fs_blocksize)) + fs_name ) ) else ( (* Inodes display. *) - printf "%10Ld %10Ld %10Ld %s\n" - fs.fs_inodes_total fs.fs_inodes_used fs.fs_inodes_avail - fs.fs_name + printf "%10s %10s %10s %s\n" + (Int63.to_string fs_inodes_total) + (Int63.to_string fs_inodes_used) + (Int63.to_string fs_inodes_avail) + fs_name ) ) in - iter_over_filesystems doms print_stats + + (* Alternate version of print_stats which writes to a CSV file. + * We ignore the human-readable option because we assume that + * the data will be post-processed by something. + *) + let print_stats_csv machine ?disk ?partno dev fs = + let name = printable_name machine ?disk ?partno dev in + + let { + Diskimage.fs_blocksize = fs_blocksize; + fs_blocks_total = fs_blocks_total; + fs_is_swap = fs_is_swap; + fs_blocks_reserved = fs_blocks_reserved; + fs_blocks_avail = fs_blocks_avail; + fs_blocks_used = fs_blocks_used; + fs_inodes_total = fs_inodes_total; + fs_inodes_reserved = fs_inodes_reserved; + fs_inodes_avail = fs_inodes_avail; + fs_inodes_used = fs_inodes_used + } = fs in + + let fs_name = Diskimage.name_of_filesystem fs in + + let row = + if fs_is_swap then + (* Swap partition. *) + [ Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024); + ""; "" ] + else ( + (* Ordinary filesystem. *) + if not !inodes then ( (* 1K block display. *) + (* 'df' doesn't count the restricted blocks. *) + let blocks_total = fs_blocks_total -^ fs_blocks_reserved in + let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in + let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in + + [ Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024); + Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024); + Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024) ] + ) else ( (* Inodes display. *) + [ Int63.to_string fs_inodes_total; + Int63.to_string fs_inodes_used; + Int63.to_string fs_inodes_avail ] + ) + ) in + + let row = name :: row @ [fs_name] in + csv_write row + in + + iter_over_filesystems machines + (if not !csv_mode then print_stats else print_stats_csv)