open ExtList
open Unix
+open Int63.Operators
+
include Diskimage_utils
+(* Use as the natural block size for disk images, but really we should
+ * use the 'blockdev -getbsz' command to find the real block size.
+ *)
+let disk_block_size = ~^512
+
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);
+ Diskimage_linux_swsuspend.plugin_id,
+ ("Linux s/w suspend", Diskimage_linux_swsuspend.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. *)
let open_machine name disks =
let disks = List.map (
fun (name, path) ->
- let dev = new block_device path in
+ let dev = new block_device path disk_block_size (* XXX *) in
{ d_name = name; d_dev = dev; d_content = `Unknown }
) disks in
{ m_name = name; m_disks = disks; m_lv_filesystems = [] }
let scan_machine ({ m_disks = m_disks } as machine) =
let m_disks = List.map (
fun ({ d_dev = dev } as disk) ->
+ let dev = (dev :> device) in
(* See if it is partitioned first. *)
let parts = probe_for_partitions dev in
match parts with
let pvs_on_disks = List.filter_map (
function
| { d_dev = d_dev;
- d_content = `PhysicalVolume pv } -> Some (pv, d_dev)
+ d_content = `PhysicalVolume pv } -> Some (pv, (d_dev :> device))
| _ -> None
) m_disks in
let pvs_on_partitions = List.map (