Removed warning about unused return value.
[virt-df.git] / lib / diskimage_utils.ml
index 4ad508d..1a85f52 100644 (file)
@@ -29,7 +29,8 @@ object (self)
   method virtual size : int63
   method virtual name : string
   method virtual blocksize : int63
-  method virtual mapblock : int63 -> (device * int63) list
+  method virtual map_block : int63 -> (device * int63) list
+  method virtual contiguous : Int63.t -> Int63.t
 
   (* Block-based read.  Inefficient so normally overridden in subclasses. *)
   method read offset len =
@@ -51,7 +52,7 @@ object (self)
     let not_mapped_error () = invalid_arg "device: read: block not mapped" in
 
     (* Copy the first block (partial). *)
-    (match self#mapblock first_blk with
+    (match self#map_block first_blk with
      | [] -> not_mapped_error ()
      | (dev, base) :: _ ->
         let len =
@@ -63,7 +64,7 @@ object (self)
     (* Copy the middle blocks. *)
     let rec loop blk =
       if blk < last_blk then (
-       (match self#mapblock blk with
+       (match self#map_block blk with
         | [] -> not_mapped_error ()
         | (dev, base) :: _ ->
             let str = dev#read ~^0 self#blocksize in
@@ -76,7 +77,7 @@ object (self)
 
     (* Copy the last block (partial). *)
     if first_blk < last_blk then (
-      match self#mapblock last_blk with
+      match self#map_block last_blk with
       | [] -> not_mapped_error ()
       | (dev, base) :: _ ->
          let len = (offset +^ len) -^ last_blk *^ blocksize in
@@ -104,12 +105,14 @@ object (self)
     let len = Int63.to_int len in
     ignore (LargeFile.lseek fd offset SEEK_SET);
     let str = String.make len '\000' in
-    read fd str 0 len;
+    ignore (read fd str 0 len);
     str
   method size = size
   method name = filename
   method blocksize = blocksize
-  method mapblock _ = []
+  method map_block _ = []
+  method contiguous offset =
+    size -^ offset
   method close () = close fd
 end
 
@@ -128,7 +131,9 @@ object
       );
     dev#read (start+^offset) len
   method blocksize = blocksize
-  method mapblock i = [dev, i *^ blocksize +^ start]
+  method map_block i = [dev, i *^ blocksize +^ start]
+  method contiguous offset =
+    size -^ offset
 end
 
 (* A device with just a modified block size. *)
@@ -137,11 +142,12 @@ object
   inherit device
   method name = dev#name
   method size = dev#size
-  method read offset len = dev#read offset len
+  method read = dev#read
   method blocksize = new_blocksize
-  method mapblock new_blk =
+  method map_block new_blk =
     let orig_blk = new_blk *^ new_blocksize /^ dev#blocksize in
-    dev#mapblock orig_blk
+    dev#map_block orig_blk
+  method contiguous offset = dev#size -^ offset
 end
 
 (* The null device.  Any attempt to read generates an error. *)
@@ -152,7 +158,8 @@ object
   method size = ~^0
   method name = "null"
   method blocksize = ~^1
-  method mapblock _ = assert false
+  method map_block _ = assert false
+  method contiguous _ = ~^0
 end
 
 type machine = {
@@ -179,6 +186,7 @@ and disk_content =
 
 and partitions = {
   parts_plugin_id : parts_plugin_id;   (* Partitioning scheme. *)
+  parts_dev : device;                  (* Partitions (whole) device. *)
   parts : partition list               (* Partitions. *)
 }
 and partition = {
@@ -213,6 +221,7 @@ and filesystem = {
 (* Physical volumes. *)
 and pv = {
   lvm_plugin_id : lvm_plugin_id;        (* The LVM plug-in. *)
+  pv_dev : device;                     (* Device covering whole PV. *)
   pv_uuid : string;                    (* UUID. *)
 }
 
@@ -254,6 +263,19 @@ let group_by ?(cmp = Pervasives.compare) ls =
   let ls' = List.rev ls' in
   List.map (fun (x, xs) -> x, List.rev xs) ls'
 
+let rec uniq ?(cmp = Pervasives.compare) = function
+  | [] -> []
+  | [x] -> [x]
+  | x :: y :: xs when cmp x y = 0 ->
+      uniq (x :: xs)
+  | x :: y :: xs ->
+      x :: uniq (y :: xs)
+
+let sort_uniq ?cmp xs =
+  let xs = ExtList.List.sort ?cmp xs in
+  let xs = uniq ?cmp xs in
+  xs
+
 let rec range a b =
   if a < b then a :: range (a+1) b
   else []