- Added #blocksize, #mapblock methods to device.
- Implement default #read method.
- Push the #close method down into the block_device subclass only.
- Updated documentation.
include Diskimage_utils
+(* Use as the natural block size for disk images, but really we should
+ * use the 'blockdev -getbsz' command to find the real block size.
+ *)
+let disk_block_size = 512
+
let partition_types = [
Diskimage_mbr.plugin_id,
("MBR", Diskimage_mbr.probe);
let open_machine name disks =
let disks = List.map (
fun (name, path) ->
- let dev = new block_device path in
+ let dev = new block_device path disk_block_size (* XXX *) in
{ d_name = name; d_dev = dev; d_content = `Unknown }
) disks in
{ m_name = name; m_disks = disks; m_lv_filesystems = [] }
let scan_machine ({ m_disks = m_disks } as machine) =
let m_disks = List.map (
fun ({ d_dev = dev } as disk) ->
+ let dev = (dev :> device) in
(* See if it is partitioned first. *)
let parts = probe_for_partitions dev in
match parts with
let pvs_on_disks = List.filter_map (
function
| { d_dev = d_dev;
- d_content = `PhysicalVolume pv } -> Some (pv, d_dev)
+ d_content = `PhysicalVolume pv } -> Some (pv, (d_dev :> device))
| _ -> None
) m_disks in
let pvs_on_partitions = List.map (
]}
*)
-(**
- {2 Machine/device model}
-
- The "machine/device model" that we currently understand looks
- like this:
-
-{v
-machines
- |
- \--- host partitions / disk image files
- ||
- guest block devices
- |
- +--> guest partitions (eg. using MBR)
- | |
- \-(1)->+--- filesystems (eg. ext3)
- |
- \--- PVs for LVM
- |||
- VGs and LVs
-v}
-
- (1) Filesystems and PVs may also appear directly on guest
- block devices.
-
- Partition schemes (eg. MBR) and filesystems register themselves
- with this main module and they are queried first to get an idea
- of the physical devices, partitions and filesystems potentially
- available to the guest.
-
- Volume management schemes (eg. LVM2) register themselves here
- and are called later with "spare" physical devices and partitions
- to see if they contain LVM data. If this results in additional
- logical volumes then these are checked for filesystems.
-
- Swap space is considered to be a dumb filesystem for the purposes
- of this discussion.
-*)
+(** {2 Device class and specialized subclasses} *)
class virtual device :
object
Note: For some types of devices, the device may have
"holes", alignment requirements, etc. so this method doesn't
imply that every byte from [0..size-1] is readable. *)
- method close : unit -> unit
- (** Close the device. This must be called to fully free up
- any resources used by the device. *)
- method virtual read : int64 -> int -> string
- (** [read offset len] reads len bytes starting at offset. *)
+ method read : int64 -> int -> string
+ (** [read offset len] reads len bytes starting at offset.
+
+ Note: A default implementation is provided for [read],
+ but it is fairly inefficient because it uses {!mapblock} to
+ map each block in the request. *)
method read_bitstring : int64 -> int -> Bitmatch.bitstring
(** [read_bitstring] is the same as [read] but returns
a pa_bitmatch-style bitstring. *)
+ method virtual blocksize : int
+ (** [blocksize] returns the natural block size of the device. *)
+ method virtual mapblock : int64 -> (device * int64) list
+ (** [mapblock] describes how a block in this device is
+ mapped down to any underlying device(s).
+
+ Returns [[]] (empty list) if there is no underlying
+ device for this block. Otherwise returns a list of
+ [(device, byte-offset)] locations where this block is mapped.
+
+ Normally the returned list has length 1, but in cases
+ such as mirroring you can have the same block mapped
+ to several underlying devices. *)
end
(**
A virtual (or physical!) device, encapsulating any translation
Note this very rare use of OOP in OCaml!
*)
-class block_device : string ->
+class block_device : string -> int ->
object
method name : string
method size : int64
- method close : unit -> unit
method read : int64 -> int -> string
method read_bitstring : int64 -> int -> Bitmatch.bitstring
+ method blocksize : int
+ method mapblock : int64 -> (device * int64) list
+ method close : unit -> unit
+ (** Close the device, freeing up the file descriptor. *)
end
- (** A concrete device which just direct-maps a file or /dev device. *)
+ (** A concrete device which just direct-maps a file or /dev device.
-class offset_device : string -> int64 -> int64 -> device ->
+ Create the device with [new block_device filename blocksize]
+ where [filename] is the path to the file or device and
+ [blocksize] is the blocksize of the device. *)
+
+class offset_device : string -> int64 -> int64 -> int -> device ->
object
method name : string
method size : int64
- method close : unit -> unit
method read : int64 -> int -> string
method read_bitstring : int64 -> int -> Bitmatch.bitstring
+ method blocksize : int
+ method mapblock : int64 -> (device * int64) list
end
(** A concrete device which maps a linear part of an underlying device.
- [new offset_device name start size dev] creates a new
+ [new offset_device name start size blocksize dev] creates a new
device which maps bytes from [start] to [start+size-1]
of the underlying device [dev] (ie. in this device they
appear as bytes [0] to [size-1]).
val null_device : device
(** The null device. Any attempt to read generates an error. *)
+(**
+ {2 Structures used to describe machines, disks, partitions and filesystems}
+
+ {3 Machine/device model}
+
+ The "machine/device model" that we currently understand looks
+ like this:
+
+{v
+machines
+ |
+ \--- host partitions / disk image files
+ ||
+ guest block devices
+ |
+ +--> guest partitions (eg. using MBR)
+ | |
+ \-(1)->+--- filesystems (eg. ext3)
+ |
+ \--- PVs for LVM
+ |||
+ VGs and LVs
+v}
+
+ (1) Filesystems and PVs may also appear directly on guest
+ block devices.
+
+ Partition schemes (eg. MBR) and filesystems register themselves
+ with this main module and they are queried first to get an idea
+ of the physical devices, partitions and filesystems potentially
+ available to the guest.
+
+ Volume management schemes (eg. LVM2) register themselves here
+ and are called later with "spare" physical devices and partitions
+ to see if they contain LVM data. If this results in additional
+ logical volumes then these are checked for filesystems.
+
+ Swap space is considered to be a dumb filesystem for the purposes
+ of this discussion.
+*)
+
type machine = {
m_name : string; (** Machine name. *)
m_disks : disk list; (** Machine disks. *)
and disk = {
d_name : string; (** Device name (eg "hda") *)
- d_dev : device; (** Disk device. *)
+ d_dev : block_device; (** Disk device. *)
d_content : disk_content; (** What's on it. *)
}
(** A single physical disk image. *)
fs_inodes_avail : int64; (** Inodes free (available). *)
fs_inodes_used : int64; (** Inodes in use. *)
}
- (** A filesystem. *)
+ (** A filesystem, with superblock contents. *)
and pv = {
lvm_plugin_id : lvm_plugin_id; (** The LVM plug-in which detected
val close_machine : machine -> unit
(** This is a convenience function which calls the [dev#close]
- method on any open devices owned by the machine. This just
+ method on any open {!block_device}s owned by the machine. This just
has the effect of closing any file descriptors which are
opened by these devices.
*)
identifying all partitions, filesystems, physical and logical
volumes that are known to this library.
+ This scans down to the level of the filesystem superblocks.
+
Returns an updated {!machine} structure with the scan results.
*)
List.fold_left max 0L
(List.map (fun (_, end_extent, _, _) -> end_extent) segments) in
let size = size_in_extents *^ extent_size in
-object
+object (self)
inherit device
method name = name
method size = size
- (* Read method checks which segment the request lies inside and
- * maps it to the underlying device. If there is no mapping then
- * we have to return an error.
- *
- * The request must lie inside a single extent, otherwise this is
- * also an error (XXX - should lift this restriction, however default
- * extent size is 4 MB so we probably won't hit this very often).
+ (* The natural blocksize for LVM devices is the extent size.
+ * NB. Throws a runtime exception if the extent size is bigger
+ * than an int (only likely to matter on 32 bit).
*)
- method read offset len =
- let offset_in_extents = offset /^ extent_size in
-
- (* Check we don't cross an extent boundary. *)
- if (offset +^ Int64.of_int (len-1)) /^ extent_size <> offset_in_extents
- then invalid_arg "linear_map_device: request crosses extent boundary";
+ method blocksize = Int64.to_int extent_size
- if offset_in_extents < 0L || offset_in_extents >= size_in_extents then
+ (* Map block (extent) i to the underlying device. *)
+ method mapblock i =
+ if i < 0L || i >= size_in_extents then
invalid_arg "linear_map_device: read outside device";
let rec loop = function
| [] ->
- invalid_arg "linear_map_device: offset not mapped"
+ []
| (start_extent, end_extent, dev, pvoffset) :: rest ->
- if start_extent <= offset_in_extents &&
- offset_in_extents < end_extent
- then dev#read (offset +^ pvoffset *^ extent_size) len
- else loop rest
+ if start_extent <= i && i < end_extent then
+ [dev, (pvoffset +^ i) *^ extent_size]
+ else
+ loop rest
in
loop segments
+
+ (* NB. Use the superclass #read method. *)
end
(*----------------------------------------------------------------------*)
let pe_start = pe_start *^ sector_size64 in
let pe_count = get_int64 "pe_count" meta in
let pe_count = pe_count *^ extent_size in
- let pvdev = new offset_device pvuuid pe_start pe_count dev in
+ let pvdev =
+ new offset_device
+ pvuuid (* name *)
+ pe_start pe_count (* start, size in bytes *)
+ (* don't really have a natural block size ... *)
+ (Int64.to_int extent_size)
+ dev (* underlying device *) in
Some (pvname, pvdev)
| _ ->
* (2) 'partno' is the partition number, starting at 1
* (cf. /dev/hda1 is the first partition).
* (3) 'dev' is the underlying block device.
+ * (4) natural blocksize to use is sector size.
*)
class partition_device partno start size dev =
let devname = dev#name in
let start = start *^ sector_size64 in
let size = size *^ sector_size64 in
object (self)
- inherit offset_device name start size dev
+ inherit offset_device name start size sector_size dev
end
(** Probe the
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
(* 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 =
object
method virtual name : string
method virtual size : int64
- method close : unit -> unit
- method virtual read : int64 -> int -> string
+ method read : int64 -> int -> string
method read_bitstring : int64 -> int -> Bitmatch.bitstring
+ method virtual blocksize : int
+ method virtual mapblock : int64 -> (device * int64) list
end
-class block_device : string ->
+class block_device : string -> int ->
object
method name : string
method size : int64
- method close : unit -> unit
method read : int64 -> int -> string
method read_bitstring : int64 -> int -> Bitmatch.bitstring
+ method blocksize : int
+ method mapblock : int64 -> (device * int64) list
+ method close : unit -> unit
end
-class offset_device : string -> int64 -> int64 -> device ->
+class offset_device : string -> int64 -> int64 -> int -> device ->
object
method name : string
method size : int64
- method close : unit -> unit
method read : int64 -> int -> string
method read_bitstring : int64 -> int -> Bitmatch.bitstring
+ method blocksize : int
+ method mapblock : int64 -> (device * int64) list
end
val null_device : device
and disk = {
d_name : string;
- d_dev : device;
+ d_dev : block_device;
d_content : disk_content;
}
List.iter (
function
| ({ Diskimage.d_content = `Filesystem fs; d_dev = dev } as disk) ->
- f dom ~disk dev fs
+ f dom ~disk (dev :> Diskimage.device) fs
| ({ Diskimage.d_content = `Partitions partitions } as disk) ->
List.iteri (
fun i ->
git.annexia.org / virt-df.git / commitdiff