(* Only close the disks, assume all other devices are derived from them. *)
List.iter (fun { d_dev = d_dev } -> d_dev#close ()) m_disks
+(* Main scanning function for filesystems. *)
let scan_machine ({ m_disks = m_disks } as machine) =
let m_disks = List.map (
fun ({ d_dev = dev } as disk) ->
{ machine with
m_disks = m_disks;
m_lv_filesystems = filesystems }
+
+(* Ownership tables. *)
+let create_ownership machine =
+ (* Iterate over all the things which can claim ownership of a
+ * disk block (filesystems, partitions, PVs).
+ *
+ * A single disk block can be "owned" by several things (eg. it
+ * could contain an LV filesystem, on a PV, on a partition).
+ *)
+ let rec iter_over_machine
+ {m_disks = disks; m_lv_filesystems = lv_filesystems} =
+ List.iter (
+ function
+ | { d_content = (`Filesystem fs as owner) } ->
+ iter_over_filesystem disks fs owner
+ | { d_content = (`Partitions parts as owner) } ->
+ iter_over_partitions disks parts owner
+ | { d_content = (`PhysicalVolume pv as owner) } ->
+ iter_over_pv disks pv owner
+ | { d_content = `Unknown } -> ()
+ ) disks;
+ List.iter (
+ fun (lv, fs) ->
+ let owner = `Filesystem fs in
+ iter_over_filesystem disks fs owner
+ ) lv_filesystems
+
+ (* Iterate over the blocks in a single filesystem. *)
+ and iter_over_filesystem disks {fs_dev = dev} owner =
+ iter_over_device disks dev owner
+
+ (* Iterate over the blocks in a set of partitions, then
+ * iterate over the contents of the partitions.
+ *)
+ and iter_over_partitions disks {parts = parts; parts_dev = parts_dev} owner =
+ iter_over_device disks parts_dev owner;
+
+ List.iter (
+ function
+ | { part_content = (`Filesystem fs as owner) } ->
+ iter_over_filesystem disks fs owner
+ | { part_content = (`PhysicalVolume pv as owner) } ->
+ iter_over_pv disks pv owner
+ | { part_content = `Unknown } -> ()
+ ) parts
+
+ (* Iterate over the blocks in a PV. *)
+ and iter_over_pv disks {pv_dev = dev} owner =
+ iter_over_device disks dev owner
+
+ (* Iterate over the blocks in a device, assigning ownership to 'owner'
+ *
+ * In reality (1): There can be several owners for each block, so we
+ * incrementally add ownership. The add_ownership function takes
+ * care of handling overlapping ranges, using an AVL tree.
+ * In reality (2): Iterating over blocks would take ages and result
+ * in a very inefficient ownership representation. Instead we look
+ * at minimum contiguous extents.
+ *)
+ and iter_over_device disks dev owner =
+ let size = dev#size in
+
+ let rec loop offset =
+ if offset < size then (
+ let extent =
+ let devs, extent = get_next_extent disks dev offset in
+ if devs = [] then
+ eprintf "warning: no device found under %s\n"
+ (string_of_owner owner);
+ List.iter (
+ fun (dev, dev_offset) ->
+ add_ownership dev dev_offset extent owner
+ ) devs;
+ extent in
+ loop (offset +^ extent)
+ )
+ in
+ loop ~^0
+
+ (* Return the length of the next contiguous region in the device starting
+ * at the given byte offset. Also return the underlying block device(s)
+ * if there is one.
+ *)
+ and get_next_extent disks (dev : device) offset =
+ let disks = List.map (fun { d_dev = dev } -> (dev :> device)) disks in
+ map_recursively disks dev offset
+
+ and map_recursively disks dev offset =
+ let this_extent = dev#contiguous offset in
+
+ (* If this disk is a block_device (a member of the 'disks' list)
+ * then we've hit the bottom layer of devices, so just return it.
+ *)
+ if List.memq dev disks then
+ [dev, offset], this_extent
+ else (
+ let blocksize = dev#blocksize in
+ let block = offset /^ blocksize in
+ let offset_in_block = offset -^ block *^ blocksize in
+
+ (* Map from this block to the devices one layer down. *)
+ let devs = dev#map_block block in
+
+ (* Get the real device offsets, adding the offset from start of block. *)
+ let devs =
+ List.map
+ (fun (dev, dev_offset) -> dev, dev_offset +^ offset_in_block)
+ devs in
+
+ let devs =
+ List.map
+ (fun (dev, dev_offset) ->
+ map_recursively disks dev dev_offset)
+ devs in
+
+ (* Work out the minimum contiguous extent from this offset. *)
+ let devs, extent =
+ let extents = List.map snd devs in
+ let devs = List.concat (List.map fst devs) in
+ let extent = List.fold_left min this_extent extents in
+ devs, extent in
+
+ devs, extent
+ )
+
+ and string_of_owner = function
+ | `Filesystem {fs_plugin_id = fs_plugin_id; fs_dev = fs_dev} ->
+ sprintf "%s(%s)" fs_dev#name fs_plugin_id
+ | `PhysicalVolume { pv_uuid = pv_uuid } ->
+ "PV:" ^ pv_uuid
+ | `Partitions { parts_plugin_id = parts_plugin_id } ->
+ parts_plugin_id
+
+ and add_ownership dev offset extent owner =
+ let blocksize = dev#blocksize in
+ let offset_in_blocks, offset_in_block =
+ offset /^ blocksize, offset %^ blocksize in
+ let extent_in_blocks, extent_in_block =
+ extent /^ blocksize, extent %^ blocksize in
+
+ eprintf "add_ownership: %s %s[%s:%s] %s[%s:%s] %s\n"
+ dev#name
+ (Int63.to_string offset)
+ (Int63.to_string offset_in_blocks)
+ (Int63.to_string offset_in_block)
+ (Int63.to_string extent)
+ (Int63.to_string extent_in_blocks)
+ (Int63.to_string extent_in_block)
+ (string_of_owner owner)
+ in
+ iter_over_machine machine
+
+
and partitions = {
parts_plugin_id : parts_plugin_id; (** Partitioning scheme. *)
+ parts_dev : device; (** Partitions (whole) device. *)
parts : partition list; (** Partitions. *)
}
and partition = {
and pv = {
lvm_plugin_id : lvm_plugin_id; (** The LVM plug-in which detected
this. *)
+ pv_dev : device; (** Device covering whole PV. *)
pv_uuid : string; (** UUID. *)
}
and lv = {
val name_of_lvm : lvm_plugin_id -> string
(** Convert plug-in IDs to printable strings. *)
-(** {2 Scanning functions} *)
+(** {2 Functions} *)
+
+(** {3 Create 'machine'} *)
val open_machine : string -> (string * string) list -> machine
(** [open_machine m_name devs]
opened by these devices.
*)
+(** {3 Scanning for filesystems} *)
+
val scan_machine : machine -> machine
(** This does a complete scan of all devices owned by a machine,
identifying all partitions, filesystems, physical and logical
Returns an updated {!machine} structure with the scan results.
*)
+(** {3 Create ownership tables} *)
+
+val create_ownership : machine -> (*ownership*)unit
+ (** This creates the ownership tables (mapping disk blocks to the
+ ultimate filesystem, etc., which owns each).
+ *)
+
(** {2 Debugging} *)
val debug : bool ref
git.annexia.org / virt-df.git / commitdiff