open Printf
open Unix
-let debug = ref false
-
-let ( +* ) = Int32.add
-let ( -* ) = Int32.sub
-let ( ** ) = Int32.mul
-let ( /* ) = Int32.div
+open Int63.Operators
-let ( +^ ) = Int64.add
-let ( -^ ) = Int64.sub
-let ( *^ ) = Int64.mul
-let ( /^ ) = Int64.div
+let debug = ref false
class virtual device =
object (self)
- method virtual read : int64 -> int -> string
- method virtual size : int64
+ method virtual size : int63
method virtual name : string
+ method virtual blocksize : int63
+ 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 =
+ if offset < ~^0 || len < ~^0 then
+ invalid_arg "device: read: negative offset or length";
+
+ let blocksize = self#blocksize in
+
+ (* Break the request into blocks.
+ * Find the first and last blocks of this request.
+ *)
+ let first_blk = offset /^ blocksize in
+ let offset_in_first_blk = offset -^ first_blk *^ blocksize in
+ let last_blk = (offset +^ len -^ ~^1) /^ blocksize in
+
+ (* Buffer for the result. *)
+ let buf = Buffer.create (Int63.to_int len) in
+
+ let not_mapped_error () = invalid_arg "device: read: block not mapped" in
+
+ (* Copy the first block (partial). *)
+ (match self#map_block first_blk with
+ | [] -> not_mapped_error ()
+ | (dev, base) :: _ ->
+ let len =
+ min len (blocksize -^ offset_in_first_blk) in
+ let str = dev#read (base +^ offset_in_first_blk) len in
+ Buffer.add_string buf str
+ );
- method close () = ()
+ (* Copy the middle blocks. *)
+ let rec loop blk =
+ if blk < last_blk then (
+ (match self#map_block blk with
+ | [] -> not_mapped_error ()
+ | (dev, base) :: _ ->
+ let str = dev#read ~^0 self#blocksize in
+ Buffer.add_string buf str
+ );
+ loop (Int63.succ blk)
+ )
+ in
+ loop (Int63.succ first_blk);
+
+ (* Copy the last block (partial). *)
+ if first_blk < last_blk then (
+ match self#map_block last_blk with
+ | [] -> not_mapped_error ()
+ | (dev, base) :: _ ->
+ let len = (offset +^ len) -^ last_blk *^ blocksize in
+ let str = dev#read ~^0 len in
+ Buffer.add_string buf str
+ );
+
+ assert (Int63.to_int len = Buffer.length buf);
+ Buffer.contents buf
(* Helper method to read a chunk of data into a bitstring. *)
method read_bitstring offset len =
let str = self#read offset len in
- (str, 0, len * 8)
+ (str, 0, String.length str lsl 3)
end
(* A concrete device which just direct-maps a file or /dev device. *)
-class block_device filename =
+class block_device filename blocksize =
let fd = openfile filename [ O_RDONLY ] 0 in
- let size = (LargeFile.fstat fd).LargeFile.st_size in
+ let size = Int63.of_int64 (LargeFile.fstat fd).LargeFile.st_size in
object (self)
inherit device
method read offset len =
+ let offset = Int63.to_int64 offset in
+ 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;
str
- method close () = close fd
method size = size
method name = filename
+ method blocksize = blocksize
+ method map_block _ = []
+ method contiguous offset =
+ size -^ offset
+ method close () = close fd
end
(* A linear offset/size from an underlying device. *)
-class offset_device name start size (dev : device) =
+class offset_device name start size blocksize (dev : device) =
object
inherit device
method name = name
method size = size
- (* method close () = dev#close () - NB: NO!! Device may be shared. *)
method read offset len =
- if offset < 0L || len < 0 || offset +^ Int64.of_int len > size then
+ if offset < ~^0 || len < ~^0 || offset +^ len > size then
invalid_arg (
- sprintf "%s: tried to read outside device boundaries (%Ld/%d/%Ld)"
- name offset len size
+ sprintf "%s: tried to read outside device boundaries (%s/%s/%s)"
+ name (Int63.to_string offset) (Int63.to_string len)
+ (Int63.to_string size)
);
dev#read (start+^offset) len
+ method blocksize = blocksize
+ method map_block i = [dev, i *^ blocksize +^ start]
+ method contiguous offset =
+ size -^ offset
+end
+
+(* A device with just a modified block size. *)
+class blocksize_overlay new_blocksize (dev : device) =
+object
+ inherit device
+ method name = dev#name
+ method size = dev#size
+ method read = dev#read
+ method blocksize = new_blocksize
+ method map_block new_blk =
+ let orig_blk = new_blk *^ new_blocksize /^ dev#blocksize in
+ dev#map_block orig_blk
+ method contiguous offset = dev#size -^ offset
end
(* The null device. Any attempt to read generates an error. *)
object
inherit device
method read _ _ = assert false
- method size = 0L
+ method size = ~^0
method name = "null"
+ method blocksize = ~^1
+ method map_block _ = assert false
+ method contiguous _ = ~^0
end
type machine = {
d_name : string; (* Device name (eg "hda") *)
(* About the device itself. *)
- d_dev : device; (* Disk device. *)
+ d_dev : block_device; (* Disk device. *)
d_content : disk_content; (* What's on it. *)
}
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 = {
(* Filesystems (also swap devices). *)
and filesystem = {
fs_plugin_id : fs_plugin_id; (* Filesystem. *)
- fs_block_size : int64; (* Block size (bytes). *)
- fs_blocks_total : int64; (* Total blocks. *)
+ fs_dev : device; (* Device containing the filesystem. *)
+ fs_blocksize : int63; (* Block size (bytes). *)
+ fs_blocks_total : int63; (* Total blocks. *)
fs_is_swap : bool; (* If swap, following not valid. *)
- fs_blocks_reserved : int64; (* Blocks reserved for super-user. *)
- fs_blocks_avail : int64; (* Blocks free (available). *)
- fs_blocks_used : int64; (* Blocks in use. *)
- fs_inodes_total : int64; (* Total inodes. *)
- fs_inodes_reserved : int64; (* Inodes reserved for super-user. *)
- fs_inodes_avail : int64; (* Inodes free (available). *)
- fs_inodes_used : int64; (* Inodes in use. *)
+ fs_blocks_reserved : int63; (* Blocks reserved for super-user. *)
+ fs_blocks_avail : int63; (* Blocks free (available). *)
+ fs_blocks_used : int63; (* Blocks in use. *)
+ fs_inodes_total : int63; (* Total inodes. *)
+ fs_inodes_reserved : int63; (* Inodes reserved for super-user. *)
+ fs_inodes_avail : int63; (* Inodes free (available). *)
+ fs_inodes_used : int63; (* Inodes in use. *)
}
(* 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. *)
}
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 []
git.annexia.org / virt-df.git / blobdiff