open Virt_df_gettext.Gettext
-let debug = true (* If true emit lots of debugging information. *)
-
let ( +* ) = Int32.add
let ( -* ) = Int32.sub
let ( ** ) = Int32.mul
let ( *^ ) = Int64.mul
let ( /^ ) = Int64.div
+let debug = ref false
let uri = ref None
let inodes = ref false
let human = ref false
method name = filename
end
+(* A linear offset/size from an underlying device. *)
+class offset_device name start size (dev : device) =
+object
+ inherit device
+ method name = name
+ method size = size
+ method read offset len =
+ if offset < 0L || len < 0 || offset +^ Int64.of_int len > size then
+ invalid_arg (
+ sprintf "%s: tried to read outside device boundaries (%Ld/%d/%Ld)"
+ name offset len size
+ );
+ dev#read (start+^offset) len
+end
+
(* The null device. Any attempt to read generates an error. *)
let null_device : device =
object
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. *)
+ dom_lv_filesystems :
+ (lv * 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 string (* 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 string (* 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 } =
if not swap then name
else name ^ " [swap]"
+(* Convert a UUID (containing '-' chars) to canonical form. *)
+let canonical_uuid uuid =
+ let uuid' = String.make 32 ' ' in
+ let j = ref 0 in
+ for i = 0 to String.length uuid - 1 do
+ if !j >= 32 then
+ invalid_arg (sprintf (f_ "canonical_uuid: UUID is too long: %s") uuid);
+ let c = uuid.[i] in
+ if c <> '-' then ( uuid'.[!j] <- c; incr j )
+ done;
+ if !j <> 32 then
+ invalid_arg (sprintf (f_ "canonical_uuid: invalid UUID: %s") uuid);
+ uuid'
+
(* Register a partition scheme. *)
let partition_types = ref []
let partition_type_register (parts_name : string) probe_fn =
(* Probe a device for partitions. Returns [Some parts] or [None]. *)
let probe_for_partitions dev =
- if debug then eprintf "probing for partitions on %s ...\n%!" dev#name;
+ if !debug then eprintf "probing for partitions on %s ...\n%!" dev#name;
let rec loop = function
| [] -> None
| (parts_name, probe_fn) :: rest ->
with Not_found -> loop rest
in
let r = loop !partition_types in
- if debug then (
+ if !debug then (
match r with
| None -> eprintf "no partitions found on %s\n%!" dev#name
| Some { parts_name = name; parts = parts } ->
(* 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;
+ if !debug then eprintf "probing for a filesystem on %s ...\n%!" dev#name;
let rec loop = function
| [] -> None
| (fs_name, probe_fn) :: rest ->
with Not_found -> loop rest
in
let r = loop !filesystem_types in
- if debug then (
+ if !debug then (
match r with
| None -> eprintf "no filesystem found on %s\n%!" dev#name
| Some fs ->
(* 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;
+ if !debug then eprintf "probing if %s is a PV ...\n%!" dev#name;
let rec loop = function
| [] -> None
| (lvm_name, (probe_fn, _)) :: rest ->
- if probe_fn dev then Some lvm_name else loop rest
+ try Some (probe_fn lvm_name dev)
+ with Not_found -> loop rest
in
let r = loop !lvm_types in
- if debug then (
+ if !debug then (
match r with
| None -> eprintf "no PV found on %s\n%!" dev#name
- | Some lvm_name ->
- eprintf "%s contains a %s PV\n%!" dev#name lvm_name
+ | Some { lvm_plugin_id = name } ->
+ eprintf "%s contains a %s PV\n%!" dev#name name
);
r
in
let ls' = List.rev ls' in
List.map (fun (x, xs) -> x, List.rev xs) ls'
+
+let rec range a b =
+ if a < b then a :: range (a+1) b
+ else []