diskimage_ext2.cmi: diskimage_utils.cmi
diskimage_linux_swap.cmi: diskimage_utils.cmi
+diskimage_lvm2_metadata.cmi: int63.cmi
diskimage_lvm2.cmi: diskimage_utils.cmi
-diskimage_lvm2_parser.cmi: diskimage_lvm2_metadata.cmi
+diskimage_lvm2_parser.cmi: int63.cmi diskimage_lvm2_metadata.cmi
diskimage_mbr.cmi: diskimage_utils.cmi
-diskimage.cmi: /usr/lib64/ocaml/bitmatch/bitmatch.cmi
-diskimage_utils.cmi: /usr/lib64/ocaml/bitmatch/bitmatch.cmi
-diskimage_ext2.cmo: diskimage_utils.cmi \
+diskimage.cmi: int63.cmi /usr/lib64/ocaml/bitmatch/bitmatch.cmi
+diskimage_utils.cmi: int63.cmi /usr/lib64/ocaml/bitmatch/bitmatch.cmi
+diskimage_ext2.cmo: int63.cmi diskimage_utils.cmi \
/usr/lib64/ocaml/bitmatch/bitmatch.cmi diskimage_ext2.cmi
-diskimage_ext2.cmx: diskimage_utils.cmx \
+diskimage_ext2.cmx: int63.cmx diskimage_utils.cmx \
/usr/lib64/ocaml/bitmatch/bitmatch.cmi diskimage_ext2.cmi
-diskimage_linux_swap.cmo: diskimage_utils.cmi \
+diskimage_linux_swap.cmo: int63.cmi diskimage_utils.cmi \
/usr/lib64/ocaml/bitmatch/bitmatch.cmi diskimage_linux_swap.cmi
-diskimage_linux_swap.cmx: diskimage_utils.cmx \
+diskimage_linux_swap.cmx: int63.cmx diskimage_utils.cmx \
/usr/lib64/ocaml/bitmatch/bitmatch.cmi diskimage_linux_swap.cmi
-diskimage_lvm2_metadata.cmo: diskimage_lvm2_metadata.cmi
-diskimage_lvm2_metadata.cmx: diskimage_lvm2_metadata.cmi
-diskimage_lvm2.cmo: diskimage_utils.cmi diskimage_lvm2_metadata.cmi \
+diskimage_lvm2_metadata.cmo: int63.cmi diskimage_lvm2_metadata.cmi
+diskimage_lvm2_metadata.cmx: int63.cmx diskimage_lvm2_metadata.cmi
+diskimage_lvm2.cmo: int63.cmi diskimage_utils.cmi diskimage_lvm2_metadata.cmi \
/usr/lib64/ocaml/bitmatch/bitmatch.cmi diskimage_lvm2.cmi
-diskimage_lvm2.cmx: diskimage_utils.cmx diskimage_lvm2_metadata.cmx \
+diskimage_lvm2.cmx: int63.cmx diskimage_utils.cmx diskimage_lvm2_metadata.cmx \
/usr/lib64/ocaml/bitmatch/bitmatch.cmi diskimage_lvm2.cmi
-diskimage_lvm2_parser.cmo: diskimage_lvm2_metadata.cmi \
+diskimage_lvm2_parser.cmo: int63.cmi diskimage_lvm2_metadata.cmi \
diskimage_lvm2_parser.cmi
-diskimage_lvm2_parser.cmx: diskimage_lvm2_metadata.cmx \
+diskimage_lvm2_parser.cmx: int63.cmx diskimage_lvm2_metadata.cmx \
diskimage_lvm2_parser.cmi
-diskimage_mbr.cmo: diskimage_utils.cmi /usr/lib64/ocaml/bitmatch/bitmatch.cmi \
- diskimage_mbr.cmi
-diskimage_mbr.cmx: diskimage_utils.cmx /usr/lib64/ocaml/bitmatch/bitmatch.cmi \
- diskimage_mbr.cmi
-diskimage.cmo: diskimage_utils.cmi diskimage_mbr.cmi diskimage_lvm2.cmi \
- diskimage_linux_swap.cmi diskimage_ext2.cmi diskimage.cmi
-diskimage.cmx: diskimage_utils.cmx diskimage_mbr.cmx diskimage_lvm2.cmx \
- diskimage_linux_swap.cmx diskimage_ext2.cmx diskimage.cmi
-diskimage_utils.cmo: diskimage_utils.cmi
-diskimage_utils.cmx: diskimage_utils.cmi
+diskimage_mbr.cmo: int63.cmi diskimage_utils.cmi \
+ /usr/lib64/ocaml/bitmatch/bitmatch.cmi diskimage_mbr.cmi
+diskimage_mbr.cmx: int63.cmx diskimage_utils.cmx \
+ /usr/lib64/ocaml/bitmatch/bitmatch.cmi diskimage_mbr.cmi
+diskimage.cmo: int63.cmi diskimage_utils.cmi diskimage_mbr.cmi \
+ diskimage_lvm2.cmi diskimage_linux_swap.cmi diskimage_ext2.cmi \
+ diskimage.cmi
+diskimage.cmx: int63.cmx diskimage_utils.cmx diskimage_mbr.cmx \
+ diskimage_lvm2.cmx diskimage_linux_swap.cmx diskimage_ext2.cmx \
+ diskimage.cmi
+diskimage_utils.cmo: int63.cmi diskimage_utils.cmi
+diskimage_utils.cmx: int63.cmx diskimage_utils.cmi
int63.cmo: int63.cmi
int63.cmx: int63.cmi
test_int63.cmo: int63.cmi
open ExtList
open Unix
+open Int63.Operators
+
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 disk_block_size = ~^512
let partition_types = [
Diskimage_mbr.plugin_id,
object
method virtual name : string
(** Return some printable name for the device. *)
- method virtual size : int64
+ method virtual size : Int63.t
(** Return the size of the device in bytes.
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 read : int64 -> int -> string
+ method read : Int63.t -> Int63.t -> 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
+ method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
(** [read_bitstring] is the same as [read] but returns
a pa_bitmatch-style bitstring. *)
- method virtual blocksize : int
+ method virtual blocksize : Int63.t
(** [blocksize] returns the natural block size of the device. *)
- method virtual mapblock : int64 -> (device * int64) list
+ method virtual mapblock : Int63.t -> (device * Int63.t) list
(** [mapblock] describes how a block in this device is
mapped down to any underlying device(s).
Note this very rare use of OOP in OCaml!
*)
-class block_device : string -> int ->
+class block_device : string -> Int63.t ->
object
method name : string
- method size : int64
- method read : int64 -> int -> string
- method read_bitstring : int64 -> int -> Bitmatch.bitstring
- method blocksize : int
- method mapblock : int64 -> (device * int64) list
+ method size : Int63.t
+ method read : Int63.t -> Int63.t -> string
+ method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
+ method blocksize : Int63.t
+ method mapblock : Int63.t -> (device * Int63.t) list
method close : unit -> unit
(** Close the device, freeing up the file descriptor. *)
end
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 ->
+class offset_device : string -> Int63.t -> Int63.t -> Int63.t -> device ->
object
method name : string
- method size : int64
- method read : int64 -> int -> string
- method read_bitstring : int64 -> int -> Bitmatch.bitstring
- method blocksize : int
- method mapblock : int64 -> (device * int64) list
+ method size : Int63.t
+ method read : Int63.t -> Int63.t -> string
+ method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
+ method blocksize : Int63.t
+ method mapblock : Int63.t -> (device * Int63.t) list
end
(** A concrete device which maps a linear part of an underlying device.
Useful for things like partitions.
*)
-class blocksize_overlay : int -> device ->
+class blocksize_overlay : Int63.t -> device ->
object
method name : string
- method size : int64
- method read : int64 -> int -> string
- method read_bitstring : int64 -> int -> Bitmatch.bitstring
- method blocksize : int
- method mapblock : int64 -> (device * int64) list
+ method size : Int63.t
+ method read : Int63.t -> Int63.t -> string
+ method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
+ method blocksize : Int63.t
+ method mapblock : Int63.t -> (device * Int63.t) list
end
(** Change the blocksize of an existing device. *)
and filesystem = {
fs_plugin_id : fs_plugin_id; (** Filesystem type. *)
fs_dev : device; (** Device containing the filesystem. *)
- fs_blocksize : int; (** Block size (bytes). *)
- fs_blocks_total : int64; (** Total blocks. *)
+ fs_blocksize : Int63.t; (** Block size (bytes). *)
+ fs_blocks_total : Int63.t; (** 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.t; (** Blocks reserved for super-user. *)
+ fs_blocks_avail : Int63.t; (** Blocks free (available). *)
+ fs_blocks_used : Int63.t; (** Blocks in use. *)
+ fs_inodes_total : Int63.t; (** Total inodes. *)
+ fs_inodes_reserved : Int63.t; (** Inodes reserved for super-user. *)
+ fs_inodes_avail : Int63.t; (** Inodes free (available). *)
+ fs_inodes_used : Int63.t; (** Inodes in use. *)
}
(** A filesystem, with superblock contents. *)
open Diskimage_utils
+open Int63.Operators
+
+let ( +* ) = Int32.add
+let ( -* ) = Int32.sub
+let ( ** ) = Int32.mul
+let ( /* ) = Int32.div
+
let plugin_id = "ext2"
-let superblock_offset = 1024L
+let superblock_offset = ~^1024
+let superblock_len = ~^1024
let probe dev =
(* Load the superblock. *)
- let bits = dev#read_bitstring superblock_offset 1024 in
+ let bits = dev#read_bitstring superblock_offset superblock_len in
(* The structure is straight from /usr/include/linux/ext3_fs.h *)
bitmatch bits with
(* Work out the block size in bytes. *)
let s_log_block_size = Int32.to_int s_log_block_size in
- let block_size = 1024L in
- let block_size = Int64.shift_left block_size s_log_block_size in
+ let block_size = ~^1024 <^< s_log_block_size in
(* Number of groups. *)
let s_groups_count =
(* Calculate the block overhead (used by superblocks, inodes, etc.)
* See fs/ext2/super.c.
*)
- let overhead = Int64.of_int32 s_first_data_block in
+ let overhead = Int63.of_int32 s_first_data_block in
let overhead = (* XXX *) overhead in
(* The blocksize of the filesystem is likely to be quite different
* from that of the underlying device, so create an overlay device
* with the natural filesystem blocksize.
*)
- let fs_dev = new blocksize_overlay (Int64.to_int block_size) dev in
+ let fs_dev = new blocksize_overlay block_size dev in
{
fs_plugin_id = plugin_id;
fs_dev = fs_dev;
- fs_blocksize = Int64.to_int block_size;
- fs_blocks_total = Int64.of_int32 s_blocks_count -^ overhead;
+ fs_blocksize = block_size;
+ fs_blocks_total = Int63.of_int32 s_blocks_count -^ overhead;
fs_is_swap = false;
- fs_blocks_reserved = Int64.of_int32 s_r_blocks_count;
- fs_blocks_avail = Int64.of_int32 s_free_blocks_count;
+ fs_blocks_reserved = Int63.of_int32 s_r_blocks_count;
+ fs_blocks_avail = Int63.of_int32 s_free_blocks_count;
fs_blocks_used =
- Int64.of_int32 s_blocks_count -^ overhead
- -^ Int64.of_int32 s_free_blocks_count;
- fs_inodes_total = Int64.of_int32 s_inodes_count;
- fs_inodes_reserved = 0L; (* XXX? *)
- fs_inodes_avail = Int64.of_int32 s_free_inodes_count;
- fs_inodes_used = Int64.of_int32 s_inodes_count
- (*-^ 0L*)
- -^ Int64.of_int32 s_free_inodes_count;
+ Int63.of_int32 s_blocks_count -^ overhead
+ -^ Int63.of_int32 s_free_blocks_count;
+ fs_inodes_total = Int63.of_int32 s_inodes_count;
+ fs_inodes_reserved = ~^0; (* XXX? *)
+ fs_inodes_avail = Int63.of_int32 s_free_inodes_count;
+ fs_inodes_used = Int63.of_int32 s_inodes_count
+ (*-^ 0*)
+ -^ Int63.of_int32 s_free_inodes_count;
}
| { _ } ->
open Diskimage_utils
-let plugin_id = "linux_swap"
+open Int63.Operators
-let blocksize = 4096 (* XXX *)
-let blocksize64 = 4096L (* XXX *)
+let plugin_id = "linux_swap"
+let blocksize = ~^4096 (* XXX *)
let probe dev =
(* Load the "superblock" (ie. first 0x1000 bytes). *)
- let bits = dev#read_bitstring 0L 0x1000 in
+ let bits = dev#read_bitstring ~^0 ~^0x1000 in
bitmatch bits with
| {
fs_dev = fs_dev;
fs_blocksize = blocksize;
- fs_blocks_total = fs_dev#size /^ blocksize64;
+ fs_blocks_total = fs_dev#size /^ blocksize;
(* The remaining fields are ignored when fs_is_swap is true. *)
fs_is_swap = true;
- fs_blocks_reserved = 0L;
- fs_blocks_avail = 0L;
- fs_blocks_used = 0L;
- fs_inodes_total = 0L;
- fs_inodes_reserved = 0L;
- fs_inodes_avail = 0L;
- fs_inodes_used = 0L;
+ fs_blocks_reserved = ~^0;
+ fs_blocks_avail = ~^0;
+ fs_blocks_used = ~^0;
+ fs_inodes_total = ~^0;
+ fs_inodes_reserved = ~^0;
+ fs_inodes_avail = ~^0;
+ fs_inodes_used = ~^0;
}
| { _ } ->
open Diskimage_utils
open Diskimage_lvm2_metadata
+open Int63.Operators
+
let plugin_id = "LVM2"
-let sector_size = 512
-let sector_size64 = 512L
+let sector_size_int = 512
+let sector_size = ~^sector_size_int
(*----------------------------------------------------------------------*)
(* Block device which can do linear maps, same as the kernel dm-linear.c *)
* satisfy any read request up to the full size.
*)
let size_in_extents =
- List.fold_left max 0L
+ List.fold_left max ~^0
(List.map (fun (_, end_extent, _, _) -> end_extent) segments) in
let size = size_in_extents *^ extent_size in
object (self)
* NB. Throws a runtime exception if the extent size is bigger
* than an int (only likely to matter on 32 bit).
*)
- method blocksize = Int64.to_int extent_size
+ method blocksize = extent_size
(* Map block (extent) i to the underlying device. *)
method mapblock i =
- if i < 0L || i >= size_in_extents then
+ if i < ~^0 || i >= size_in_extents then
invalid_arg "linear_map_device: read outside device";
let rec loop = function
* the nineth sector contains some additional information about
* the location of the current metadata.
*)
- let bits = dev#read_bitstring 0L (9 * sector_size) in
+ let bits = dev#read_bitstring ~^0 (~^9 *^ sector_size) in
(*Bitmatch.hexdump_bitstring stdout bits;*)
bitmatch bits with
| {
(* sector 0 *)
- sector0 : sector_size*8 : bitstring;
+ sector0 : sector_size_int*8 : bitstring;
(* sector 1 *)
"LABELONE" : 64 : string; (* "LABELONE" *)
_ : 128 : bitstring; (* Seems to contain something. *)
"LVM2 001" : 64 : string; (* "LVM2 001" *)
uuid : 256 : string; (* UUID *)
- endsect : (sector_size-64)*8 : bitstring; (* to end of second sector *)
+ endsect : (sector_size_int-64)*8 : bitstring;(* to end of second sector *)
(* sectors 2-7 *)
- sectors234567 : sector_size*8 * 6 : bitstring;
+ sectors234567 : sector_size_int*8 * 6 : bitstring;
(* sector 8 *)
_ : 320 : bitstring; (* start of sector 8 *)
} ->
(* Metadata offset is relative to end of PV label. *)
- let metadata_offset = metadata_offset +* 0x1000_l in
+ let metadata_offset = Int63.of_int32 metadata_offset +^ ~^0x1000 in
(* Metadata length appears to include the trailing \000 which
* we don't want.
*)
- let metadata_length = metadata_length -* 1_l in
+ let metadata_length = Int63.of_int32 metadata_length -^ ~^1 in
let metadata = read_metadata dev metadata_offset metadata_length in
(sprintf "LVM2: read_pv_label: %s: not an LVM2 physical volume"
dev#name)
-and read_metadata dev offset32 len32 =
+and read_metadata dev offset len =
if !debug then
- eprintf "metadata: offset 0x%lx len %ld bytes\n%!" offset32 len32;
+ eprintf "metadata: offset %s len %s bytes\n%!"
+ (Int63.to_string offset) (Int63.to_string len);
(* Check the offset and length are sensible. *)
- let offset64 =
- if offset32 <= Int32.max_int then Int64.of_int32 offset32
- else invalid_arg "LVM2: read_metadata: metadata offset too large" in
- let len64 =
- if len32 <= 2_147_483_647_l then Int64.of_int32 len32
- else invalid_arg "LVM2: read_metadata: metadata length too large" in
-
- if offset64 <= 0x1200L || offset64 >= dev#size
- || len64 <= 0L || offset64 +^ len64 >= dev#size then
+ if offset <= ~^0x1200 || offset >= dev#size
+ || len <= ~^0 || offset +^ len >= dev#size then
invalid_arg "LVM2: read_metadata: bad metadata offset or length";
(* If it is outside the disk boundaries, this will throw an exception,
* otherwise it will read and return the metadata string.
*)
- dev#read offset64 (Int64.to_int len64)
+ dev#read offset len
(*----------------------------------------------------------------------*)
(* We are passed a list of devices which we previously identified
(* Some useful getter functions. If these can't get a value
* from the metadata or if the type is wrong they raise Not_found.
*)
- let rec get_int64 field meta =
+ let rec get_int63 field meta =
match List.assoc field meta with
| Int i -> i
| _ -> raise Not_found
- and get_int field meta min max =
+ and get_int_bounded field meta max =
match List.assoc field meta with
- | Int i when Int64.of_int min <= i && i <= Int64.of_int max ->
- Int64.to_int i
+ | Int i when i >= ~^0 && i <= Int63.of_int max -> Int63.to_int i
| _ -> raise Not_found
and get_string field meta =
match List.assoc field meta with
let pvdevs, extent_size =
try
(* NB: extent_size is in sectors here - we convert to bytes. *)
- let extent_size = get_int "extent_size" vgmeta 0 (1024*1024) in
- let extent_size = Int64.of_int extent_size *^ sector_size64 in
+ let extent_size =
+ get_int_bounded "extent_size" vgmeta (1024*1024) in
+ let extent_size = Int63.of_int extent_size in
+ let extent_size = extent_size *^ sector_size in
(* Get the physical_volumes section of the metadata. *)
let pvdevs = get_meta "physical_volumes" vgmeta in
let _, dev = List.assoc pvuuid pvs in
(* Construct a PV device. *)
- let pe_start = get_int64 "pe_start" meta in
- let pe_start = pe_start *^ sector_size64 in
- let pe_count = get_int64 "pe_count" meta in
+ let pe_start = get_int63 "pe_start" meta in
+ let pe_start = pe_start *^ sector_size in
+ let pe_count = get_int63 "pe_count" meta in
let pe_count = pe_count *^ extent_size 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)
+ extent_size
dev (* underlying device *) in
Some (pvname, pvdev)
) pvdevs, extent_size
with
(* Something went wrong - just return an empty map. *)
- Not_found -> [], 0L in
+ Not_found -> [], ~^0 in
(vgname, (pvuuids, vgmeta, pvdevs, extent_size))
) vgs in
function
| lvname, Metadata lvmeta ->
(try
- let segment_count = get_int "segment_count" lvmeta 0 1024 in
+ let segment_count =
+ get_int_bounded "segment_count" lvmeta 1024 in
(* Get the segments for this LV. *)
let segments = range 1 (segment_count+1) in
List.map (
fun segmeta ->
let start_extent =
- get_int64 "start_extent" segmeta in
+ get_int63 "start_extent" segmeta in
let extent_count =
- get_int64 "extent_count" segmeta in
+ get_int63 "extent_count" segmeta in
let segtype = get_string "type" segmeta in
(* Can only handle striped segments at the
if segtype <> "striped" then raise Not_found;
let stripe_count =
- get_int "stripe_count" segmeta 0 1024 in
+ get_int_bounded "stripe_count" segmeta 1024 in
let stripes = get_stripes "stripes" segmeta in
if List.length stripes <> stripe_count then
if !debug then (
List.iter (
fun (vgname, (pvuuids, vgmeta, pvdevs, extent_size, lvs)) ->
- eprintf "VG %s: (extent_size = %Ld bytes)\n" vgname extent_size;
+ eprintf "VG %s: (extent_size = %s bytes)\n" vgname
+ (Int63.to_string extent_size);
List.iter (
fun (lvname, segments) ->
eprintf " %s/%s:\n" vgname lvname;
List.iter (
fun (start_extent, extent_count, pvname, pvoffset) ->
- eprintf " start %Ld count %Ld at %s:%Ld\n"
- start_extent extent_count pvname pvoffset
+ eprintf " start %s count %s at %s:%s\n"
+ (Int63.to_string start_extent)
+ (Int63.to_string extent_count)
+ pvname (Int63.to_string pvoffset)
) segments
) lvs
) vgs;
(* integers *)
| ('-'? digit+) as i
{
- let i = Int64.of_string i in
+ let i = Int63.of_string i in
INT i
}
and metavalue =
| Metadata of metadata (* name { ... } *)
| String of string (* name = "..." *)
- | Int of int64
+ | Int of Int63.t
| Float of float
| List of metavalue list (* name = [...] *)
output_string chan str;
output_char chan '"';
| Int i ->
- output_string chan (Int64.to_string i)
+ output_string chan (Int63.to_string i)
| Float f ->
output_string chan (string_of_float f)
| List [] -> ()
and metavalue =
| Metadata of metadata (* name { ... } *)
| String of string (* name = "..." *)
- | Int of int64
+ | Int of Int63.t
| Float of float
| List of metavalue list (* name = [...] *)
%token EQ /* = */
%token COMMA /* , */
%token <string> STRING /* "string" */
-%token <int64> INT /* an integer */
+%token <Int63.t> INT /* an integer */
%token <float> FLOAT /* a float */
%token <string> IDENT /* a naked keyword/identifier */
%token EOF /* end of file */
open Diskimage_utils
+open Int63.Operators
+
let plugin_id = "mbr"
-let sector_size = 512
-let sector_size64 = 512L
+let sector_size = ~^512
(* Maximum number of extended partitions possible. *)
let max_extended_partitions = 100
class partition_device partno start size dev =
let devname = dev#name in
let name = sprintf "%s%d" devname partno in
- let start = start *^ sector_size64 in
- let size = size *^ sector_size64 in
+ let start = start *^ sector_size in
+ let size = size *^ sector_size in
object (self)
inherit offset_device name start size sector_size dev
end
let rec probe dev =
(* Read the first sector. *)
let bits =
- try dev#read_bitstring 0L sector_size
+ try dev#read_bitstring ~^0 sector_size
with exn -> raise Not_found in
(* Does this match a likely-looking MBR? *)
part_dev = null_device; part_content = `Unknown }
and make_mbr_entry part_status dev partno part_type first_lba part_size =
- let first_lba = uint64_of_int32 first_lba in
- let part_size = uint64_of_int32 part_size in
+ let first_lba = Int63.of_int32 first_lba in
+ let part_size = Int63.of_int32 part_size in
+ (*
+ XXX Used to be:
+ let first_lba = uint63_of_int32 first_lba in
+ let part_size = uint63_of_int32 part_size in
+ *)
if !debug then
- eprintf "make_mbr_entry: first_lba = %Lx part_size = %Lx\n%!"
- first_lba part_size;
+ eprintf "make_mbr_entry: first_lba = %s part_size = %s\n%!"
+ (Int63.to_string first_lba) (Int63.to_string part_size);
{ part_status = part_status;
part_type = part_type;
part_dev = new partition_device partno first_lba part_size dev;
else []
*)
+(*
(* Ugh, fake a UInt32 -> UInt64 conversion without sign extension, until
* we get working UInt32/UInt64 modules in extlib.
*)
let i64 = Int64.of_int32 u32 in
if u32 >= 0l then i64
else Int64.add i64 0x1_0000_0000_L
+*)
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 mapblock : int63 -> (device * int63) list
(* 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
| [] -> 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
);
(match self#mapblock 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
| [] -> 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 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 mapblock i = [dev, i *^ blocksize +^ start]
end
(* A device with just a modified block 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
+ let orig_blk = new_blk *^ new_blocksize /^ dev#blocksize in
dev#mapblock orig_blk
end
object
inherit device
method read _ _ = assert false
- method size = 0L
+ method size = ~^0
method name = "null"
- method blocksize = 1
+ method blocksize = ~^1
method mapblock _ = assert false
end
and filesystem = {
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_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. *)
class virtual device :
object
method virtual name : string
- method virtual size : int64
- method read : int64 -> int -> string
- method read_bitstring : int64 -> int -> Bitmatch.bitstring
- method virtual blocksize : int
- method virtual mapblock : int64 -> (device * int64) list
+ method virtual size : Int63.t
+ method read : Int63.t -> Int63.t -> string
+ method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
+ method virtual blocksize : Int63.t
+ method virtual mapblock : Int63.t -> (device * Int63.t) list
end
-class block_device : string -> int ->
+class block_device : string -> Int63.t ->
object
method name : string
- method size : int64
- method read : int64 -> int -> string
- method read_bitstring : int64 -> int -> Bitmatch.bitstring
- method blocksize : int
- method mapblock : int64 -> (device * int64) list
+ method size : Int63.t
+ method read : Int63.t -> Int63.t -> string
+ method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
+ method blocksize : Int63.t
+ method mapblock : Int63.t -> (device * Int63.t) list
method close : unit -> unit
end
-class offset_device : string -> int64 -> int64 -> int -> device ->
+class offset_device : string -> Int63.t -> Int63.t -> Int63.t -> device ->
object
method name : string
- method size : int64
- method read : int64 -> int -> string
- method read_bitstring : int64 -> int -> Bitmatch.bitstring
- method blocksize : int
- method mapblock : int64 -> (device * int64) list
+ method size : Int63.t
+ method read : Int63.t -> Int63.t -> string
+ method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
+ method blocksize : Int63.t
+ method mapblock : Int63.t -> (device * Int63.t) list
end
-class blocksize_overlay : int -> device ->
+class blocksize_overlay : Int63.t -> device ->
object
method name : string
- method size : int64
- method read : int64 -> int -> string
- method read_bitstring : int64 -> int -> Bitmatch.bitstring
- method blocksize : int
- method mapblock : int64 -> (device * int64) list
+ method size : Int63.t
+ method read : Int63.t -> Int63.t -> string
+ method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
+ method blocksize : Int63.t
+ method mapblock : Int63.t -> (device * Int63.t) list
end
val null_device : device
and filesystem = {
fs_plugin_id : fs_plugin_id;
fs_dev : device;
- fs_blocksize : int;
- fs_blocks_total : int64;
+ fs_blocksize : Int63.t;
+ fs_blocks_total : Int63.t;
fs_is_swap : bool;
- fs_blocks_reserved : int64;
- fs_blocks_avail : int64;
- fs_blocks_used : int64;
- fs_inodes_total : int64;
- fs_inodes_reserved : int64;
- fs_inodes_avail : int64;
- fs_inodes_used : int64;
+ fs_blocks_reserved : Int63.t;
+ fs_blocks_avail : Int63.t;
+ fs_blocks_used : Int63.t;
+ fs_inodes_total : Int63.t;
+ fs_inodes_reserved : Int63.t;
+ fs_inodes_avail : Int63.t;
+ fs_inodes_used : Int63.t;
}
and pv = {
(** [range a b] returns the list of integers [a <= i < b].
If [a >= b] then the empty list is returned.
*)
-
-val ( +* ) : int32 -> int32 -> int32
-val ( -* ) : int32 -> int32 -> int32
-val ( ** ) : int32 -> int32 -> int32
-val ( /* ) : int32 -> int32 -> int32
-
-val ( +^ ) : int64 -> int64 -> int64
-val ( -^ ) : int64 -> int64 -> int64
-val ( *^ ) : int64 -> int64 -> int64
-val ( /^ ) : int64 -> int64 -> int64
-(** int32 and int64 infix operators for convenience. *)
virt_df_csv.cmo: virt_df.cmi virt_df_csv.cmi
virt_df_csv.cmx: virt_df.cmx virt_df_csv.cmi
-virt_df_main.cmo: virt_df_gettext.cmo virt_df.cmi ../lib/diskimage.cmi
-virt_df_main.cmx: virt_df_gettext.cmx virt_df.cmx ../lib/diskimage.cmx
+virt_df_main.cmo: virt_df_gettext.cmo virt_df.cmi ../lib/int63.cmi \
+ ../lib/diskimage.cmi
+virt_df_main.cmx: virt_df_gettext.cmx virt_df.cmx ../lib/int63.cmx \
+ ../lib/diskimage.cmx
virt_df.cmo: virt_df_gettext.cmo virt_df.cmi
virt_df.cmx: virt_df_gettext.cmx virt_df.cmi
module C = Libvirt.Connect
module D = Libvirt.Domain
+open Int63.Operators
+
open Virt_df_gettext.Gettext
open Virt_df
-let ( +* ) = Int32.add
-let ( -* ) = Int32.sub
-let ( ** ) = Int32.mul
-let ( /* ) = Int32.div
-
-let ( +^ ) = Int64.add
-let ( -^ ) = Int64.sub
-let ( *^ ) = Int64.mul
-let ( /^ ) = Int64.div
-
let () =
(* Command line argument parsing. *)
let set_uri = function "" -> uri := None | u -> uri := Some u in
csv_write [ "Filesystem"; total; used; avail; "Type" ] in
let printable_size bytes =
- if bytes < 1024L *^ 1024L then
- sprintf "%Ld bytes" bytes
- else if bytes < 1024L *^ 1024L *^ 1024L then
- sprintf "%.1f MiB" (Int64.to_float (bytes /^ 1024L) /. 1024.)
+ if bytes < ~^1024 *^ ~^1024 then
+ sprintf "%s bytes" (Int63.to_string bytes)
+ else if bytes < ~^1024 *^ ~^1024 *^ ~^1024 then
+ sprintf "%.1f MiB" (Int63.to_float (bytes /^ ~^1024) /. 1024.)
else
- sprintf "%.1f GiB" (Int64.to_float (bytes /^ 1024L /^ 1024L) /. 1024.)
+ sprintf "%.1f GiB" (Int63.to_float (bytes /^ ~^1024 /^ ~^1024) /. 1024.)
in
(* HOF to iterate over filesystems. *)
fs_inodes_avail = fs_inodes_avail;
fs_inodes_used = fs_inodes_used
} = fs in
- let fs_blocksize = Int64.of_int fs_blocksize in
let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
if fs_is_swap then (
(* Swap partition. *)
if not !human then
- printf "%10Ld %s\n"
- (fs_blocksize *^ fs_blocks_total /^ 1024L) fs_name
+ printf "%10s %s\n"
+ (Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024))
+ fs_name
else
printf "%10s %s\n"
- (printable_size (fs_blocksize *^ fs_blocks_total)) fs_name
+ (printable_size (fs_blocksize *^ fs_blocks_total))
+ fs_name
) else (
(* Ordinary filesystem. *)
if not !inodes then ( (* Block display. *)
(* 'df' doesn't count the restricted blocks. *)
let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
- let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in
+ let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
if not !human then ( (* Display 1K blocks. *)
- printf "%10Ld %10Ld %10Ld %s\n"
- (blocks_total *^ fs_blocksize /^ 1024L)
- (fs_blocks_used *^ fs_blocksize /^ 1024L)
- (blocks_avail *^ fs_blocksize /^ 1024L)
+ printf "%10s %10s %10s %s\n"
+ (Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024))
+ (Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024))
+ (Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024))
fs_name
) else ( (* Human-readable blocks. *)
printf "%10s %10s %10s %s\n"
fs_name
)
) else ( (* Inodes display. *)
- printf "%10Ld %10Ld %10Ld %s\n"
- fs_inodes_total fs_inodes_used fs_inodes_avail
+ printf "%10s %10s %10s %s\n"
+ (Int63.to_string fs_inodes_total)
+ (Int63.to_string fs_inodes_used)
+ (Int63.to_string fs_inodes_avail)
fs_name
)
)
fs_inodes_avail = fs_inodes_avail;
fs_inodes_used = fs_inodes_used
} = fs in
- let fs_blocksize = Int64.of_int fs_blocksize in
let fs_name = Diskimage.name_of_filesystem fs_plugin_id in
let row =
if fs_is_swap then
(* Swap partition. *)
- [ Int64.to_string (fs_blocksize *^ fs_blocks_total /^ 1024L);
+ [ Int63.to_string (fs_blocksize *^ fs_blocks_total /^ ~^1024);
""; "" ]
else (
(* Ordinary filesystem. *)
(* 'df' doesn't count the restricted blocks. *)
let blocks_total = fs_blocks_total -^ fs_blocks_reserved in
let blocks_avail = fs_blocks_avail -^ fs_blocks_reserved in
- let blocks_avail = if blocks_avail < 0L then 0L else blocks_avail in
+ let blocks_avail = if blocks_avail < ~^0 then ~^0 else blocks_avail in
- [ Int64.to_string (blocks_total *^ fs_blocksize /^ 1024L);
- Int64.to_string (fs_blocks_used *^ fs_blocksize /^ 1024L);
- Int64.to_string (blocks_avail *^ fs_blocksize /^ 1024L) ]
+ [ Int63.to_string (blocks_total *^ fs_blocksize /^ ~^1024);
+ Int63.to_string (fs_blocks_used *^ fs_blocksize /^ ~^1024);
+ Int63.to_string (blocks_avail *^ fs_blocksize /^ ~^1024) ]
) else ( (* Inodes display. *)
- [ Int64.to_string fs_inodes_total;
- Int64.to_string fs_inodes_used;
- Int64.to_string fs_inodes_avail ]
+ [ Int63.to_string fs_inodes_total;
+ Int63.to_string fs_inodes_used;
+ Int63.to_string fs_inodes_avail ]
)
) in
git.annexia.org / virt-df.git / commitdiff