The main program consists of two modules:
- - diskimage.ml / diskimage.mli (module name: Diskimage)
+ - diskimage.ml / diskimage.mli
+
+ This is the library. It loads the domain descriptions, calls out
+ to the plug-ins to probe for disks / partitions / filesystems /
+ etc., and finally returns the results.
+
+ - diskimage_utils.ml / diskimage_utils.mli (module name: Diskimage_utils)
This has evolved into a library of miscellaneous functions
and values which are included throughout the rest of the
Start by reading diskimage.mli which contains the full types
and plenty of documentation.
- - diskimage_main.ml
-
- This is the program. It reads the command line arguments,
- loads the domain descriptions, calls out to the plug-ins
- to probe for disks / partitions / filesystems / etc., and
- finally prints the results.
-
- The file consists of basically one large program that
- does all of the above in sequence.
-
Everything else in this directory is a plug-in specialized for probing
a particular filesystem, partition scheme or type of LVM. The
plug-ins at time of writing are:
include Diskimage_utils
let partition_types = [
- "MBR", Diskimage_mbr.probe_mbr;
+ Diskimage_mbr.plugin_id,
+ ("MBR", Diskimage_mbr.probe);
]
let filesystem_types = [
- "ext2", Diskimage_ext2.probe_ext2;
- "linux_swap", Diskimage_linux_swap.probe_swap;
+ Diskimage_ext2.plugin_id,
+ ("Linux ext2/3", Diskimage_ext2.probe);
+ Diskimage_linux_swap.plugin_id,
+ ("Linux swap", Diskimage_linux_swap.probe);
]
let lvm_types = [
- "LVM", (Diskimage_lvm2.probe_pv, Diskimage_lvm2.list_lvs);
+ Diskimage_lvm2.plugin_id,
+ ("Linux LVM2", Diskimage_lvm2.probe, Diskimage_lvm2.list);
]
+let name_of_parts id =
+ let name, _ = List.assoc id partition_types in
+ name
+let name_of_filesystem id =
+ let name, _ = List.assoc id filesystem_types in
+ name
+let name_of_lvm id =
+ let name, _, _ = List.assoc id lvm_types in
+ name
+
(* 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;
let rec loop = function
| [] -> None
- | (parts_name, probe_fn) :: rest ->
+ | (parts_plugin_id, (_, probe_fn)) :: rest ->
try Some (probe_fn dev)
with Not_found -> loop rest
in
if !debug then (
match r with
| None -> eprintf "no partitions found on %s\n%!" dev#name
- | Some { parts_name = name; parts = parts } ->
- eprintf "found %d %s partitions on %s:\n"
- (List.length parts) name dev#name;
- List.iter (fun p -> eprintf "\t%s\n%!" (string_of_partition p)) parts
+ | Some { parts_plugin_id = name; parts = parts } ->
+ eprintf "found %d %s partitions on %s\n"
+ (List.length parts) name dev#name
);
r
if !debug then eprintf "probing for a filesystem on %s ...\n%!" dev#name;
let rec loop = function
| [] -> None
- | (fs_name, probe_fn) :: rest ->
+ | (fs_name, (_, probe_fn)) :: rest ->
try Some (probe_fn dev)
with Not_found -> loop rest
in
| None -> eprintf "no filesystem found on %s\n%!" dev#name
| Some fs ->
eprintf "found a filesystem on %s:\n" dev#name;
- eprintf "\t%s\n%!" (string_of_filesystem fs)
+ eprintf "\t%s\n%!" fs.fs_plugin_id
);
r
if !debug then eprintf "probing if %s is a PV ...\n%!" dev#name;
let rec loop = function
| [] -> None
- | (lvm_name, (probe_fn, _)) :: rest ->
+ | (lvm_name, (_, probe_fn, _)) :: rest ->
try Some (probe_fn lvm_name dev)
with Not_found -> loop rest
in
r
let list_lvs lvm_name devs =
- let _, list_lvs_fn = List.assoc lvm_name lvm_types in
+ let _, _, list_lvs_fn = List.assoc lvm_name lvm_types in
list_lvs_fn devs
(* Create machine description. *)
]
and partitions = {
- parts_name : string; (** Name of partitioning scheme. *)
+ parts_plugin_id : parts_plugin_id; (** Partitioning scheme. *)
parts : partition list; (** Partitions. *)
}
and partition = {
]
and filesystem = {
- fs_name : string; (** Name of filesystem. *)
+ fs_plugin_id : fs_plugin_id; (** Filesystem type. *)
fs_block_size : int64; (** Block size (bytes). *)
fs_blocks_total : int64; (** Total blocks. *)
fs_is_swap : bool; (** If swap, following not valid. *)
}
(** Physical and logical volumes as used by LVM plug-ins. *)
+and parts_plugin_id
+and fs_plugin_id
and lvm_plugin_id
+ (** Opaque IDs used to refer to the plug-ins. *)
-val string_of_partition : partition -> string
-val string_of_filesystem : filesystem -> string
- (** Convert a partition or filesystem struct to a string (for debugging). *)
+val name_of_parts : parts_plugin_id -> string
+val name_of_filesystem : fs_plugin_id -> string
+val name_of_lvm : lvm_plugin_id -> string
+ (** Convert plug-in IDs to printable strings. *)
(** {2 Scanning functions} *)
open Diskimage_utils
+let plugin_id = "ext2"
let superblock_offset = 1024L
-let probe_ext2 dev =
+let probe dev =
(* Load the superblock. *)
let bits = dev#read_bitstring superblock_offset 1024 in
let overhead = (* XXX *) overhead in
{
- fs_name = "Linux ext2/3";
+ fs_plugin_id = plugin_id;
fs_block_size = block_size;
fs_blocks_total = Int64.of_int32 s_blocks_count -^ overhead;
fs_is_swap = false;
(**/**)
-val probe_ext2 : Diskimage_utils.device -> Diskimage_utils.filesystem
+val plugin_id : string
+val probe : Diskimage_utils.device -> Diskimage_utils.filesystem
open Diskimage_utils
-let probe_swap dev =
+let plugin_id = "linux_swap"
+
+let probe dev =
(* Load the "superblock" (ie. first 0x1000 bytes). *)
let bits = dev#read_bitstring 0L 0x1000 in
"SWAPSPACE2" : 80 : string
} ->
{
- fs_name = "Linux swap";
+ fs_plugin_id = plugin_id;
fs_block_size = 4096L; (* XXX *)
fs_blocks_total = dev#size /^ 4096L;
(**/**)
-val probe_swap : Diskimage_utils.device -> Diskimage_utils.filesystem
+val plugin_id : string
+val probe : Diskimage_utils.device -> Diskimage_utils.filesystem
open Diskimage_utils
open Diskimage_lvm2_metadata
-let plugin_name = "LVM2"
+let plugin_id = "LVM2"
let sector_size = 512
let sector_size64 = 512L
(*----------------------------------------------------------------------*)
(* Probe to see if it's an LVM2 PV. *)
-let rec probe_pv lvm_plugin_id dev =
+let rec probe lvm_plugin_id dev =
try
let uuid, _ = read_pv_label dev in
if !debug then
* (as devices) and return them. Note that we don't try to detect
* what is on these LVs - that will be done in the main code.
*)
-let rec list_lvs devs =
+let rec list devs =
(* Read the UUID and metadata (again) from each device to end up with
* an assoc list of PVs, keyed on the UUID.
*)
(**/**)
-val probe_pv :
+val plugin_id : string
+
+val probe :
Diskimage_utils.lvm_plugin_id -> Diskimage_utils.device ->
Diskimage_utils.pv
-val list_lvs : Diskimage_utils.device list -> Diskimage_utils.lv list
+val list : Diskimage_utils.device list -> Diskimage_utils.lv list
open Diskimage_utils
+let plugin_id = "mbr"
+
let sector_size = 512
let sector_size64 = 512L
@raise Not_found if it is not an MBR.
*)
-let rec probe_mbr dev =
+let rec probe dev =
(* Read the first sector. *)
let bits =
try dev#read_bitstring 0L sector_size
let extendeds = List.concat extendeds in
primaries @ extendeds
*)
- { parts_name = "MBR"; parts = primaries }
+ { parts_plugin_id = plugin_id; parts = primaries }
| { _ } ->
raise Not_found (* not an MBR *)
(**/**)
-val probe_mbr : Diskimage_utils.device -> Diskimage_utils.partitions
+val plugin_id : string
+val probe : Diskimage_utils.device -> Diskimage_utils.partitions
(* Partitions. *)
and partitions = {
- parts_name : string; (* Name of partitioning scheme. *)
+ parts_plugin_id : parts_plugin_id; (* Partitioning scheme. *)
parts : partition list (* Partitions. *)
}
and partition = {
(* Filesystems (also swap devices). *)
and filesystem = {
- fs_name : string; (* Name of filesystem. *)
+ fs_plugin_id : fs_plugin_id; (* Filesystem. *)
fs_block_size : int64; (* Block size (bytes). *)
fs_blocks_total : int64; (* Total blocks. *)
fs_is_swap : bool; (* If swap, following not valid. *)
lv_dev : device; (* Logical volume device. *)
}
+and parts_plugin_id = string
+and fs_plugin_id = string
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 } =
- sprintf "%s: %s partition type %d"
- dev#name
- (match status with
- | Bootable -> "bootable"
- | Nonbootable -> "nonbootable"
- | Malformed -> "malformed"
- | NullEntry -> "empty")
- typ
-
-let string_of_filesystem { fs_name = name; fs_is_swap = swap } =
- 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
]
and partitions = {
- parts_name : string;
+ parts_plugin_id : parts_plugin_id;
parts : partition list;
}
and partition = {
]
and filesystem = {
- fs_name : string;
+ fs_plugin_id : fs_plugin_id;
fs_block_size : int64;
fs_blocks_total : int64;
fs_is_swap : bool;
lv_dev : device;
}
+and parts_plugin_id = string
+and fs_plugin_id = string
and lvm_plugin_id = string
-val string_of_partition : partition -> string
-val string_of_filesystem : filesystem -> string
-
(** {2 Internal functions used by the plug-ins} *)
val canonical_uuid : string -> string
printf "%-32s " name;
let {
- Diskimage.fs_name = fs_name;
+ Diskimage.fs_plugin_id = fs_plugin_id;
fs_block_size = fs_block_size;
fs_blocks_total = fs_blocks_total;
fs_is_swap = fs_is_swap;
fs_inodes_used = fs_inodes_used
} = fs in
+ let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
+
if fs_is_swap then (
(* Swap partition. *)
if not !human then
let name = printable_name machine ?disk ?partno dev in
let {
- Diskimage.fs_name = fs_name;
+ Diskimage.fs_plugin_id = fs_plugin_id;
fs_block_size = fs_block_size;
fs_blocks_total = fs_blocks_total;
fs_is_swap = fs_is_swap;
fs_inodes_used = fs_inodes_used
} = fs in
+ let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
+
let row =
if fs_is_swap then
(* Swap partition. *)
git.annexia.org / virt-df.git / commitdiff