Updated MANIFEST.

[virt-top.git] / virt-df / virt_df_main.ml

diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml
index 82fe920..65d1f2f 100644 (file)
--- a/virt-df/virt_df_main.ml
+++ b/virt-df/virt_df_main.ml
@@ -54,6 +54,8 @@ let () =
       "uri " ^ s_ "Connect to URI (default: Xen)";
     "--connect", Arg.String set_uri,
       "uri " ^ s_ "Connect to URI (default: Xen)";
+    "--debug", Arg.Set debug,
+      " " ^ s_ "Debug mode (default: false)";
     "-h", Arg.Set human,
       " " ^ s_ "Print sizes in human-readable format";
     "--human-readable", Arg.Set human,
@@ -63,7 +65,7 @@ let () =
     "--inodes", Arg.Set inodes,
       " " ^ s_ "Show inodes instead of blocks";
     "-t", Arg.String test_mode,
-      "dev" ^ s_ "(Test mode) Display contents of block device or file";
+      "dev " ^ s_ "(Test mode) Display contents of block device or file";
     "--version", Arg.Unit version,
       " " ^ s_ "Display version and exit";
   ] in
@@ -322,6 +324,10 @@ OPTIONS" in
    * (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 (
@@ -330,7 +336,7 @@ OPTIONS" in
       let pvs_on_disks = List.filter_map (
        function
        | { d_dev = d_dev;
-           d_content = `PhysicalVolume lvm_name } -> Some (lvm_name, d_dev)
+           d_content = `PhysicalVolume pv } -> Some (pv, d_dev)
        | _ -> None
       ) disks in
       let pvs_on_partitions = List.map (
@@ -339,8 +345,8 @@ OPTIONS" in
            List.filter_map (
              function
              | { part_dev = part_dev;
-                 part_content = `PhysicalVolume lvm_name } ->
-                   Some (lvm_name, part_dev)
+                 part_content = `PhysicalVolume pv } ->
+                   Some (pv, part_dev)
              | _ -> None
            ) parts
        | _ -> []
@@ -353,18 +359,24 @@ OPTIONS" in
   let doms = List.map (
     fun (dom, lvs) ->
       (* Group the LVs by plug-in type. *)
-      let cmp ((a:string),_) ((b:string),_) = compare a b in
+      let cmp (a,_) (b,_) = compare a b in
       let lvs = List.sort ~cmp lvs in
       let lvs = group_by lvs in
 
       let lvs =
-       List.map (fun (lvm_name, devs) -> list_lvs lvm_name devs) lvs in
+       List.map (fun (pv, devs) -> list_lvs pv.lvm_plugin_id devs) lvs in
       let lvs = List.concat lvs in
 
       (* 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 probe_for_filesystem lvs in
+      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
@@ -393,45 +405,48 @@ OPTIONS" in
 
   (* HOF to iterate over filesystems. *)
   let iter_over_filesystems doms
-      (f : domain -> ?disk:disk -> ?part:(partition * int) -> filesystem ->
+      (f : domain -> ?disk:disk -> ?partno:int -> device -> filesystem ->
        unit) =
     List.iter (
       fun ({ dom_disks = disks; dom_lv_filesystems = filesystems } as dom) ->
        (* Ordinary filesystems found on disks & partitions. *)
        List.iter (
          function
-         | ({ d_content = `Filesystem fs } as disk) ->
-             f dom ~disk fs
+         | ({ d_content = `Filesystem fs; d_dev = dev } as disk) ->
+             f dom ~disk dev fs
          | ({ d_content = `Partitions partitions } as disk) ->
              List.iteri (
                fun i ->
                  function
-                 | ({ part_content = `Filesystem fs } as part) ->
-                     f dom ~disk ~part:(part, i) fs
+                 | { part_content = `Filesystem fs; part_dev = dev } ->
+                     f dom ~disk ~partno:(i+1) dev fs
                  | _ -> ()
              ) partitions.parts
          | _ -> ()
        ) disks;
        (* LV filesystems. *)
-       List.iter (fun fs -> f dom fs) filesystems
+       List.iter (fun ({lv_dev = dev}, fs) -> f dom dev fs) filesystems
     ) doms
   in
 
   (* Print stats for each recognized filesystem. *)
-  let print_stats dom ?disk ?part fs =
+  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 -> "???" (* XXX keep LV dev around *)
+       | None -> dev#name
        | Some disk -> disk.d_target
       in
-      match part with
+      match partno with
       | None ->
          dom_name ^ ":" ^ disk_name
-      | Some (_, pnum) ->
-         dom_name ^ ":" ^ disk_name ^ string_of_int pnum in
+      | Some partno ->
+         dom_name ^ ":" ^ disk_name ^ string_of_int partno in
     printf "%-20s " name;
 
     if fs.fs_is_swap then (