X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=virt-df%2Fvirt_df.ml;h=f8f34ab6b52a041c220ac323ccc51c07244ef048;hb=81294675f6a5058a3381871f1dc99c806922d77c;hp=c61f6df0ee1da164b93512285410f1ab7bf19b8a;hpb=748302caa93af2c412bcd30dad5787a5a24e9af5;p=virt-top.git

diff --git a/virt-df/virt_df.ml b/virt-df/virt_df.ml
index c61f6df..f8f34ab 100644
--- a/virt-df/virt_df.ml
+++ b/virt-df/virt_df.ml
@@ -81,6 +81,7 @@ type domain = {
   dom_name : string;			(* Domain name. *)
   dom_id : int option;			(* Domain ID (if running). *)
   dom_disks : disk list;		(* Domain disks. *)
+  dom_lv_filesystems : filesystem list;	(* Domain LV filesystems. *)
 }
 and disk = {
   (* From the XML ... *)
@@ -97,7 +98,7 @@ and disk_content =
   [ `Unknown				(* Not probed or unknown. *)
   | `Partitions of partitions		(* Contains partitions. *)
   | `Filesystem of filesystem		(* Contains a filesystem directly. *)
-  | `PhysicalVolume of unit		(* Contains an LVM PV. *)
+  | `PhysicalVolume of pv		(* Contains an LVM PV. *)
   ]
 
 (* Partitions. *)
@@ -116,7 +117,7 @@ and partition_status = Bootable | Nonbootable | Malformed | NullEntry
 and partition_content =
   [ `Unknown				(* Not probed or unknown. *)
   | `Filesystem of filesystem		(* Filesystem. *)
-  | `PhysicalVolume of unit		(* Contains an LVM PV. *)
+  | `PhysicalVolume of pv		(* Contains an LVM PV. *)
   ]
 
 (* Filesystems (also swap devices). *)
@@ -134,6 +135,19 @@ and filesystem = {
   fs_inodes_used : int64;		(* Inodes in use. *)
 }
 
+(* Physical volumes. *)
+and pv = {
+  lvm_plugin_id : lvm_plugin_id;        (* The LVM plug-in. *)
+  pv_uuid : string;			(* UUID. *)
+}
+
+(* Logical volumes. *)
+and lv = {
+  lv_dev : device;			(* Logical volume device. *)
+}
+
+and lvm_plugin_id = string
+
 (* Convert partition, filesystem types to printable strings for debugging. *)
 let string_of_partition
     { part_status = status; part_type = typ; part_dev = dev } =
@@ -180,8 +194,8 @@ let filesystem_types = ref []
 let filesystem_type_register (fs_name : string) probe_fn =
   filesystem_types := (fs_name, probe_fn) :: !filesystem_types
 
-(* Probe a device for filesystems.  Returns [Some fs] or [None]. *)
-let probe_for_filesystems dev =
+(* Probe a device for a filesystem.  Returns [Some fs] or [None]. *)
+let probe_for_filesystem dev =
   if debug then eprintf "probing for a filesystem on %s ...\n%!" dev#name;
   let rec loop = function
     | [] -> None
@@ -200,8 +214,47 @@ let probe_for_filesystems dev =
   r
 
 (* Register a volume management type. *)
-(*
 let lvm_types = ref []
-let lvm_type_register (lvm_name : string) probe_fn =
-  lvm_types := (lvm_name, probe_fn) :: !lvm_types
-*)
+let lvm_type_register (lvm_name : string) probe_fn list_lvs_fn =
+  lvm_types := (lvm_name, (probe_fn, list_lvs_fn)) :: !lvm_types
+
+(* Probe a device for a PV.  Returns [Some lvm_name] or [None]. *)
+let probe_for_pv dev =
+  if debug then eprintf "probing if %s is a PV ...\n%!" dev#name;
+  let rec loop = function
+    | [] -> None
+    | (lvm_name, (probe_fn, _)) :: rest ->
+	try Some (probe_fn lvm_name dev)
+	with Not_found -> loop rest
+  in
+  let r = loop !lvm_types in
+  if debug then (
+    match r with
+    | None -> eprintf "no PV found on %s\n%!" dev#name
+    | Some { lvm_plugin_id = name } ->
+	eprintf "%s contains a %s PV\n%!" dev#name name
+  );
+  r
+
+let list_lvs lvm_name devs =
+  let _, list_lvs_fn = List.assoc lvm_name !lvm_types in
+  list_lvs_fn devs
+
+(*----------------------------------------------------------------------*)
+
+(* This version by Isaac Trotts. *)
+let group_by ?(cmp = Pervasives.compare) ls =
+  let ls' =
+    List.fold_left
+      (fun acc (day1, x1) ->
+         match acc with
+             [] -> [day1, [x1]]
+           | (day2, ls2) :: acctl ->
+               if cmp day1 day2 = 0
+               then (day1, x1 :: ls2) :: acctl
+               else (day1, [x1]) :: acc)
+      []
+      ls
+  in
+  let ls' = List.rev ls' in
+  List.map (fun (x, xs) -> x, List.rev xs) ls'