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 size : int64
+ method virtual size : int63
method virtual name : string
- method virtual blocksize : int
- method virtual mapblock : int64 -> (device * int64) list
+ 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 < 0L || len < 0 then
+ if offset < ~^0 || len < ~^0 then
invalid_arg "device: read: negative offset or length";
- let blocksize64 = Int64.of_int self#blocksize in
+ let blocksize = 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
+ 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 len in
+ 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#mapblock first_blk with
+ (match self#map_block first_blk with
| [] -> not_mapped_error ()
| (dev, base) :: _ ->
let len =
- min len (Int64.to_int (blocksize64 -^ offset_in_first_blk)) in
+ min len (blocksize -^ 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
+ (match self#map_block blk with
| [] -> not_mapped_error ()
| (dev, base) :: _ ->
- let str = dev#read 0L self#blocksize in
+ let str = dev#read ~^0 self#blocksize in
Buffer.add_string buf str
);
- loop (Int64.succ blk)
+ loop (Int63.succ blk)
)
in
- loop (Int64.succ first_blk);
+ loop (Int63.succ first_blk);
(* 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 +^ Int64.of_int len) -^ last_blk *^ blocksize64 in
- let len = Int64.to_int len in
- let str = dev#read 0L len in
+ let len = (offset +^ len) -^ last_blk *^ blocksize in
+ let str = dev#read ~^0 len in
Buffer.add_string buf str
);
- assert (len = Buffer.length buf);
+ 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 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;
method size = size
method name = filename
method blocksize = blocksize
- method mapblock _ = []
+ method map_block _ = []
+ method contiguous offset =
+ size -^ offset
method close () = close fd
end
method name = name
method size = size
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 mapblock i = [dev, i *^ Int64.of_int blocksize +^ start]
+ 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 mapblock _ = assert false
+ method blocksize = ~^1
+ method map_block _ = assert false
+ method contiguous _ = ~^0
end
type machine = {
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 []