class virtual device =
object (self)
- method virtual read : int64 -> int -> string
method virtual size : int64
method virtual name : string
+ method virtual blocksize : int
+ method virtual mapblock : int64 -> (device * int64) list
- method close () = ()
+ (* Block-based read. Inefficient so normally overridden in subclasses. *)
+ method read offset len =
+ if offset < 0L || len < 0 then
+ invalid_arg "device: read: negative offset or length";
+
+ let blocksize64 = Int64.of_int self#blocksize in
+
+ (* Break the request into blocks.
+ * Find the first and last blocks of this request.
+ *)
+ let first_blk = offset /^ blocksize64 in
+ let offset_in_first_blk = offset -^ first_blk *^ blocksize64 in
+ let last_blk = (offset +^ Int64.of_int (len-1)) /^ blocksize64 in
+
+ (* Buffer for the result. *)
+ let buf = Buffer.create len in
+
+ let not_mapped_error () = invalid_arg "device: read: block not mapped" in
+
+ (* Copy the first block (partial). *)
+ (match self#mapblock first_blk with
+ | [] -> not_mapped_error ()
+ | (dev, base) :: _ ->
+ let len =
+ min len (Int64.to_int (blocksize64 -^ offset_in_first_blk)) in
+ let str = dev#read (base +^ offset_in_first_blk) len in
+ Buffer.add_string buf str
+ );
+
+ (* Copy the middle blocks. *)
+ let rec loop blk =
+ if blk < last_blk then (
+ (match self#mapblock blk with
+ | [] -> not_mapped_error ()
+ | (dev, base) :: _ ->
+ let str = dev#read 0L self#blocksize in
+ Buffer.add_string buf str
+ );
+ loop (Int64.succ blk)
+ )
+ in
+ loop (Int64.succ first_blk);
+
+ (* Copy the last block (partial). *)
+ if first_blk < last_blk then (
+ match self#mapblock last_blk with
+ | [] -> not_mapped_error ()
+ | (dev, base) :: _ ->
+ let len = (offset +^ Int64.of_int len) -^ last_blk *^ blocksize64 in
+ let len = Int64.to_int len in
+ let str = dev#read 0L len in
+ Buffer.add_string buf str
+ );
+
+ assert (len = Buffer.length buf);
+ Buffer.contents buf
(* Helper method to read a chunk of data into a bitstring. *)
method read_bitstring offset len =
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
object (self)
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 mapblock _ = []
+ 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
invalid_arg (
name offset len size
);
dev#read (start+^offset) len
+ method blocksize = blocksize
+ method mapblock i = [dev, i *^ Int64.of_int blocksize +^ start]
+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 offset len = dev#read offset len
+ method blocksize = new_blocksize
+ method mapblock new_blk =
+ let orig_blk =
+ new_blk *^ Int64.of_int new_blocksize /^ Int64.of_int dev#blocksize in
+ dev#mapblock orig_blk
end
(* The null device. Any attempt to read generates an error. *)
method read _ _ = assert false
method size = 0L
method name = "null"
+ method blocksize = 1
+ method mapblock _ = assert false
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 =
(* Partitions. *)
and partitions = {
- parts_name : string; (* Name of partitioning scheme. *)
+ parts_plugin_id : parts_plugin_id; (* Partitioning scheme. *)
parts : partition list (* Partitions. *)
}
and partition = {
(* Filesystems (also swap devices). *)
and filesystem = {
- fs_name : string; (* Name of filesystem. *)
- fs_block_size : int64; (* Block size (bytes). *)
+ fs_plugin_id : fs_plugin_id; (* Filesystem. *)
+ fs_dev : device; (* Device containing the filesystem. *)
+ fs_blocksize : int; (* Block size (bytes). *)
fs_blocks_total : int64; (* Total blocks. *)
fs_is_swap : bool; (* If swap, following not valid. *)
fs_blocks_reserved : int64; (* Blocks reserved for super-user. *)
lv_dev : device; (* Logical volume device. *)
}
+and parts_plugin_id = string
+and fs_plugin_id = string
and lvm_plugin_id = string
-(* Convert partition, filesystem types to printable strings for debugging. *)
-let string_of_partition
- { part_status = status; part_type = typ; part_dev = dev } =
- sprintf "%s: %s partition type %d"
- dev#name
- (match status with
- | Bootable -> "bootable"
- | Nonbootable -> "nonbootable"
- | Malformed -> "malformed"
- | NullEntry -> "empty")
- typ
-
-let string_of_filesystem { fs_name = name; fs_is_swap = swap } =
- if not swap then name
- else name ^ " [swap]"
-
(* Convert a UUID (containing '-' chars) to canonical form. *)
let canonical_uuid uuid =
let uuid' = String.make 32 ' ' in
git.annexia.org / virt-df.git / blobdiff