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 ... *)
[ `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. *)
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). *)
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 } =
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
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'