X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=lib%2Fdiskimage.ml;h=71f56b453b41229e4bf16791de1864afec0530f2;hb=85e0fa36cd0d2ff50e4d6c5811fc9761553be1c3;hp=389358b98c3bb5f17f55abdd601afbcd32da5c33;hpb=de49d4605c37574f38b55b400db310f368640c94;p=virt-df.git

diff --git a/lib/diskimage.ml b/lib/diskimage.ml
index 389358b..71f56b4 100644
--- a/lib/diskimage.ml
+++ b/lib/diskimage.ml
@@ -30,6 +30,8 @@ include Diskimage_utils
  *)
 let disk_block_size = ~^512
 
+(*----------------------------------------------------------------------*)
+(* The plug-ins. *)
 let partition_types = [
   Diskimage_mbr.plugin_id,
     ("MBR", Diskimage_mbr.probe);
@@ -119,6 +121,7 @@ let list_lvs lvm_name devs =
   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 (
@@ -249,93 +252,179 @@ let scan_machine ({ m_disks = m_disks } as machine) =
       m_disks = m_disks;
       m_lv_filesystems = filesystems }
 
+(*----------------------------------------------------------------------*)
+
+(* We describe the ownership of each part of the disk using a
+ * segment tree. http://en.wikipedia.org/wiki/Segment_tree
+ *
+ * Note that each part can (and usually is) owned multiple times
+ * (eg. by a filesystem and by the partition that the filesystem
+ * lies inside).  Also, the segment tree is effectively read-only.
+ * We build it up as a final step given the flat list of segments
+ * identified by the algorithm in 'iter_over_machine'.
+ *)
+
+(* General binary tree type.  Data 'a is stored in the leaves and 'b
+ * is stored in the nodes.
+ *)
+type ('a,'b) binary_tree =
+  | Leaf of 'a
+  | Node of ('a,'b) binary_tree * 'b * ('a,'b) binary_tree
+
+(* This prints out the binary tree in graphviz dot format. *)
+let print_binary_tree leaf_printer node_printer tree =
+  (* Assign a unique, fixed label to each node. *)
+  let label =
+    let i = ref 0 in
+    let hash = Hashtbl.create 13 in
+    fun node ->
+      try Hashtbl.find hash node
+      with Not_found ->
+	let i = incr i; !i in
+	let label = "n" ^ string_of_int i in
+	Hashtbl.add hash node label;
+	label
+  in
+  (* Recursively generate the graphviz file. *)
+  let rec print = function
+    | (Leaf a as leaf) ->
+	eprintf "  %s [shape=box, label=\"%s\"];\n"
+	  (label leaf) (leaf_printer a)
+    | (Node (left,b,right) as node) ->
+	eprintf "  %s [label=\"%s\"];\n"
+	  (label node) (node_printer b);
+	eprintf "  %s -> %s [tailport=sw];\n" (label node) (label left);
+	eprintf "  %s -> %s [tailport=se];\n" (label node) (label right);
+	print left;
+	print right;
+  in
+  eprintf "/* Use 'dot -Tpng foo.dot > foo.png' to convert to a png file. */\n";
+  eprintf "digraph G {\n";
+  print tree;
+  eprintf "}\n";
+
+(* A segment describes the owner of a range of disk addresses. *)
+type segment =
+    int63 * int63 *			(* disk offset, size of segment *)
+      [ `Filesystem of filesystem
+      | `Partitions of partitions
+      | `PhysicalVolume of pv ] *	(* owner *)
+      int63				(* owner offset *)
+
+type interval = int63 * int63		(* start point, end point (bytes) *)
+
+(* The special segment tree structure that we construct in create_ownership. *)
+type segment_tree =
+    (interval * segment list, interval * segment list) binary_tree
+
+type ownership =
+    (device *				(* block_device (disk) *)
+       segment_tree) list	        (* segment tree for this disk *)
+
+(* List of owned segments before we build the segment tree. *)
+type ownership_list =
+    (device *				(* block_device (disk) *)
+       segment) list
+
 (* 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
+      ({m_disks = disks; m_lv_filesystems = lv_filesystems} as machine) =
+
+    (* No segments to begin with. *)
+    let ownership = [] in
+
+    (* Iterate over disks. *)
+    let ownership =
+      List.fold_left (
+	fun ownership ->
+	  function
+	  | { d_content = (`Filesystem fs as owner) } ->
+	      iter_over_filesystem machine ownership fs owner
+	  | { d_content = (`Partitions parts as owner) } ->
+	      iter_over_partitions machine ownership parts owner
+	  | { d_content = (`PhysicalVolume pv as owner) } ->
+	      iter_over_pv machine ownership pv owner
+	  | { d_content = `Unknown } -> ownership
+      ) ownership disks in
+
+    (* Iterate over LV filesystems. *)
+    let ownership =
+      List.fold_left (
+	fun ownership (lv, fs) ->
+	  let owner = `Filesystem fs in
+	  iter_over_filesystem machine ownership fs owner
+      ) ownership lv_filesystems in
+
+    ownership
 
   (* Iterate over the blocks in a single filesystem. *)
-  and iter_over_filesystem disks {fs_dev = dev} owner =
-    iter_over_device disks dev owner
+  and iter_over_filesystem machine ownership {fs_dev = dev} owner =
+    iter_over_device machine ownership 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;
+  and iter_over_partitions machine ownership
+      {parts = parts; parts_dev = parts_dev} owner =
+    let ownership = iter_over_device machine ownership parts_dev owner in
 
-    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
+    let ownership =
+      List.fold_left (
+	fun ownership ->
+	  function
+	  | { part_content = (`Filesystem fs as owner) } ->
+	      iter_over_filesystem machine ownership fs owner
+	  | { part_content = (`PhysicalVolume pv as owner) } ->
+	      iter_over_pv machine ownership pv owner
+	  | { part_content = `Unknown } -> ownership
+      ) ownership parts in
+
+    ownership
 
   (* Iterate over the blocks in a PV. *)
-  and iter_over_pv disks {pv_dev = dev} owner =
-    iter_over_device disks dev owner
+  and iter_over_pv machine ownership {pv_dev = dev} owner =
+    iter_over_device machine ownership 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.
+   * incrementally add ownership to the ownership_list (which eventually
+   * will be turned into a segment 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 =
+  and iter_over_device { m_disks = disks } ownership dev owner =
     let size = dev#size in
+    let disks = List.map (fun {d_dev = dev} -> (dev :> device)) disks in
 
-    let rec loop offset =
+    let rec loop ownership 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)
+	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);
+	let ownership =
+	  List.fold_left (
+	    fun ownership (disk, disk_offset) ->
+	      let elem = disk, (disk_offset, extent, owner, offset) in
+	      elem :: ownership
+	  ) ownership devs in
+	loop ownership (offset +^ extent)
       )
+      else ownership
     in
-    loop ~^0
+    loop ownership ~^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)
@@ -360,7 +449,7 @@ let create_ownership machine =
       let devs =
 	List.map
 	  (fun (dev, dev_offset) ->
-	     map_recursively disks dev dev_offset)
+	     get_next_extent disks dev dev_offset)
 	  devs in
 
       (* Work out the minimum contiguous extent from this offset. *)
@@ -380,24 +469,191 @@ let create_ownership machine =
 	"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
 
+  (* Build the list of segments. *)
+  let ownership : ownership_list = iter_over_machine machine in
+
+  (* Group the segments together by disk. *)
+  let ownership =
+    let ownership = List.sort ownership in
+    group_by ownership in
 
+  (* If debugging, print the segments that we found. *)
+  if !debug then (
+    List.iter (
+      fun (disk, segments) ->
+	eprintf "ownership segment list of %s %s:\n" machine.m_name disk#name;
+	List.iter (
+	  fun (disk_offset, size, owner, owner_offset) ->
+	    let blocksize = disk#blocksize in
+	    let disk_offset_in_blocks, disk_offset_in_block =
+	      disk_offset /^ blocksize, disk_offset %^ blocksize in
+	    let size_in_blocks, size_in_block =
+	      size /^ blocksize, size %^ blocksize in
+
+	    eprintf "  %s[%s:%s] %s[%s:%s] %s@%s\n"
+	      (Int63.to_string disk_offset)
+                (Int63.to_string disk_offset_in_blocks)
+                (Int63.to_string disk_offset_in_block)
+	      (Int63.to_string size)
+                (Int63.to_string size_in_blocks)
+                (Int63.to_string size_in_block)
+	      (string_of_owner owner)
+	      (Int63.to_string owner_offset)
+	) segments
+    ) ownership
+  );
+
+  (* Build the segment tree from the ownership list (of segments).
+   * For an explanation of this process see:
+   * http://en.wikipedia.org/wiki/Segment_tree
+   *)
+  let ownership =
+    List.map (
+      fun (disk, segments) ->
+	(* Construct the list of distinct endpoints. *)
+	let eps =
+	  List.map
+	    (fun (start, size, _, _) -> [start; start +^ size])
+	    segments in
+	let eps = sort_uniq (List.concat eps) in
+
+	(* Construct the elementary intervals. *)
+	let elints =
+	  let elints, lastpoint =
+	    List.fold_left (
+	      fun (elints, prevpoint) point ->
+		((point, point) :: (prevpoint, point) :: elints), point
+	    ) ([], Int63.min_int) eps in
+	  let elints = (lastpoint, Int63.max_int) :: elints in
+	  List.rev elints in
+
+	if !debug then (
+	  eprintf "elementary intervals for %s (%d in total):\n"
+	    disk#name (List.length elints);
+	  List.iter (
+	    fun (startpoint, endpoint) ->
+	      eprintf "  %s %s\n"
+		(Int63.to_string startpoint) (Int63.to_string endpoint)
+	  ) elints
+	);
+
+	(* Construct the binary tree of elementary intervals. *)
+	let tree =
+	  (* Each elementary interval becomes a leaf. *)
+	  let elints = List.map (fun elint -> Leaf elint) elints in
+	  (* Recursively build this into a binary tree. *)
+	  let rec make_layer = function
+	    | [] -> []
+	    | ([_] as x) -> x
+	    (* Turn pairs of leaves at the bottom level into nodes. *)
+	    | (Leaf _ as a) :: (Leaf _ as b) :: xs ->
+		let xs = make_layer xs in
+		Node (a, (), b) :: xs
+	    (* Turn pairs of nodes at higher levels into nodes. *)
+	    | (Node _ as left) :: ((Node _|Leaf _) as right) :: xs ->
+		let xs = make_layer xs in
+		Node (left, (), right) :: xs
+	    | Leaf _ :: _ -> assert false (* never happens??? (I think) *)
+	  in
+	  let rec loop = function
+	    | [] -> assert false
+	    | [x] -> x
+	    | xs -> loop (make_layer xs)
+	  in
+	  loop elints in
+
+	if !debug then (
+	  let leaf_printer (startpoint, endpoint) =
+	    sprintf "%s-%s"
+	      (Int63.to_string startpoint) (Int63.to_string endpoint)
+	  in
+	  let node_printer () = "" in
+	  print_binary_tree leaf_printer node_printer tree
+	);
+
+	(* Insert the segments into the tree one by one. *)
+	let tree =
+	  (* For each node/leaf in the tree, add its interval and an
+	   * empty list which will be used to store the segments.
+	   *)
+	  let rec interval_tree = function
+	    | Leaf elint -> Leaf (elint, [])
+	    | Node (left, (), right) ->
+		let left = interval_tree left in
+		let right = interval_tree right in
+		let (leftstart, _) = interval_of_node left in
+		let (_, rightend) = interval_of_node right in
+		let interval = leftstart, rightend in
+		Node (left, (interval, []), right)
+	  and interval_of_node = function
+	    | Leaf (elint, _) -> elint
+	    | Node (_, (interval, _), _) -> interval
+	  in
+
+	  let tree = interval_tree tree in
+	  (* This should always be true: *)
+	  assert (interval_of_node tree = (Int63.min_int, Int63.max_int));
+
+	  (* "Contained in" operator.
+	   * 'a <-< b' iff 'a' is a subinterval of 'b'.
+	   *      |<---- a ---->|
+	   * |<----------- b ----------->|
+	   *)
+	  let (<-<) (a1, a2) (b1, b2) = b1 <= a1 && a2 <= b2 in
+
+	  (* "Intersects" operator.
+	   * 'a /\ b' iff intervals 'a' and 'b' overlap, eg:
+	   *      |<---- a ---->|
+	   *                |<----------- b ----------->|
+	   *)
+	  let ( /\ ) (a1, a2) (b1, b2) = a2 > b1 || b2 > a1 in
+
+	  let rec insert_segment tree segment =
+	    let start, size, owner, owner_offset = segment in
+	    let seginterval = start, start +^ size in
+	    eprintf "inserting (%s,%s) ...\n"
+	      (Int63.to_string (fst seginterval))
+	      (Int63.to_string (snd seginterval));
+	    match tree with
+	    (* Test if we should insert into this leaf or node: *)
+	    | Leaf (interval, segs) when interval <-< seginterval ->
+		Leaf (interval, segment :: segs)
+	    | Node (left, (interval, segs), right)
+		when interval <-< seginterval ->
+		Node (left, (interval, segment :: segs), right)
+
+	    | (Leaf _) as leaf -> leaf
+
+	    (* Else, should we insert into left or right subtrees? *)
+	    | Node (left, i, right) ->
+		let left =
+		  if seginterval /\ interval_of_node left then
+		    insert_segment left segment
+		  else
+		    left in
+		let right =
+		  if seginterval /\ interval_of_node right then
+		    insert_segment right segment
+		  else
+		    right in
+		Node (left, i, right)
+	  in
+	  let tree = List.fold_left insert_segment tree segments in
+	  tree in
+
+	if !debug then (
+	  let printer ((sp, ep), segments) =
+	    sprintf "[%s-%s] " (Int63.to_string sp) (Int63.to_string ep) ^
+	      String.concat ";"
+	      (List.map (fun (_, _, owner,_) -> string_of_owner owner)
+		 segments)
+	  in
+	  print_binary_tree printer printer tree
+	);
+	(disk, tree)
+    ) ownership in
+
+  (* Return the ownership structure. *)
+  ownership