From 063c6a300ed7ed6a9ec99d22159b3e246d08a70a Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Thu, 1 Jan 1970 00:00:00 +0000 Subject: [PATCH] Convert everything to use int63 type throughout. --- lib/.depend | 49 +++++++++++++----------- lib/diskimage.ml | 4 +- lib/diskimage.mli | 64 +++++++++++++++---------------- lib/diskimage_ext2.ml | 43 ++++++++++++--------- lib/diskimage_linux_swap.ml | 24 ++++++------ lib/diskimage_lvm2.ml | 83 ++++++++++++++++++++-------------------- lib/diskimage_lvm2_lexer.mll | 2 +- lib/diskimage_lvm2_metadata.ml | 4 +- lib/diskimage_lvm2_metadata.mli | 2 +- lib/diskimage_lvm2_parser.mly | 2 +- lib/diskimage_mbr.ml | 26 ++++++++----- lib/diskimage_utils.ml | 85 +++++++++++++++++++---------------------- lib/diskimage_utils.mli | 75 ++++++++++++++++-------------------- virt-df/.depend | 6 ++- virt-df/virt_df_main.ml | 64 ++++++++++++++----------------- 15 files changed, 266 insertions(+), 267 deletions(-) diff --git a/lib/.depend b/lib/.depend index 580dcca..406b891 100644 --- a/lib/.depend +++ b/lib/.depend @@ -1,38 +1,41 @@ 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 diff --git a/lib/diskimage.ml b/lib/diskimage.ml index 37533f1..b08c50d 100644 --- a/lib/diskimage.ml +++ b/lib/diskimage.ml @@ -21,12 +21,14 @@ open Printf 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, diff --git a/lib/diskimage.mli b/lib/diskimage.mli index 3f59bad..9247551 100644 --- a/lib/diskimage.mli +++ b/lib/diskimage.mli @@ -34,24 +34,24 @@ class virtual device : 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). @@ -72,14 +72,14 @@ class virtual device : 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 @@ -89,14 +89,14 @@ class block_device : string -> int -> 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. @@ -108,14 +108,14 @@ class offset_device : string -> int64 -> int64 -> int -> 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. *) @@ -207,16 +207,16 @@ and partition_content = 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. *) diff --git a/lib/diskimage_ext2.ml b/lib/diskimage_ext2.ml index 2226255..3f72ca4 100644 --- a/lib/diskimage_ext2.ml +++ b/lib/diskimage_ext2.ml @@ -24,12 +24,20 @@ open Printf 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 @@ -88,8 +96,7 @@ let probe dev = (* 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 = @@ -110,35 +117,35 @@ let probe dev = (* 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; } | { _ } -> diff --git a/lib/diskimage_linux_swap.ml b/lib/diskimage_linux_swap.ml index c5aff63..b9f01b1 100644 --- a/lib/diskimage_linux_swap.ml +++ b/lib/diskimage_linux_swap.ml @@ -22,14 +22,14 @@ 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 | { @@ -44,17 +44,17 @@ let probe dev = 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; } | { _ } -> diff --git a/lib/diskimage_lvm2.ml b/lib/diskimage_lvm2.ml index 0f00e1f..ea127cb 100644 --- a/lib/diskimage_lvm2.ml +++ b/lib/diskimage_lvm2.ml @@ -26,10 +26,12 @@ open ExtList 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 *) @@ -48,7 +50,7 @@ class linear_map_device name extent_size segments = * 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) @@ -60,11 +62,11 @@ 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 @@ -99,24 +101,24 @@ and read_pv_label dev = * 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 *) @@ -126,11 +128,11 @@ and read_pv_label dev = } -> (* 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 @@ -141,26 +143,20 @@ and read_pv_label dev = (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 @@ -231,14 +227,13 @@ let rec list devs = (* 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 @@ -276,8 +271,10 @@ let rec list devs = 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 @@ -293,16 +290,16 @@ let rec list devs = 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) @@ -311,7 +308,7 @@ let rec list devs = ) 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 @@ -328,7 +325,8 @@ let rec list devs = 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 @@ -341,9 +339,9 @@ let rec list devs = 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 @@ -352,7 +350,7 @@ let rec list devs = 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 @@ -386,14 +384,17 @@ let rec list devs = 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; diff --git a/lib/diskimage_lvm2_lexer.mll b/lib/diskimage_lvm2_lexer.mll index 0a791b2..21136dc 100644 --- a/lib/diskimage_lvm2_lexer.mll +++ b/lib/diskimage_lvm2_lexer.mll @@ -82,7 +82,7 @@ rule token = parse (* integers *) | ('-'? digit+) as i { - let i = Int64.of_string i in + let i = Int63.of_string i in INT i } diff --git a/lib/diskimage_lvm2_metadata.ml b/lib/diskimage_lvm2_metadata.ml index c5e3f90..1043fbb 100644 --- a/lib/diskimage_lvm2_metadata.ml +++ b/lib/diskimage_lvm2_metadata.ml @@ -26,7 +26,7 @@ and metastmt = string * metavalue 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 = [...] *) @@ -54,7 +54,7 @@ and output_metavalue chan prefix = function 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 [] -> () diff --git a/lib/diskimage_lvm2_metadata.mli b/lib/diskimage_lvm2_metadata.mli index 778f393..b5e0c82 100644 --- a/lib/diskimage_lvm2_metadata.mli +++ b/lib/diskimage_lvm2_metadata.mli @@ -26,7 +26,7 @@ and metastmt = string * metavalue 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 = [...] *) diff --git a/lib/diskimage_lvm2_parser.mly b/lib/diskimage_lvm2_parser.mly index f6d942f..700f222 100644 --- a/lib/diskimage_lvm2_parser.mly +++ b/lib/diskimage_lvm2_parser.mly @@ -31,7 +31,7 @@ %token EQ /* = */ %token COMMA /* , */ %token STRING /* "string" */ -%token INT /* an integer */ +%token INT /* an integer */ %token FLOAT /* a float */ %token IDENT /* a naked keyword/identifier */ %token EOF /* end of file */ diff --git a/lib/diskimage_mbr.ml b/lib/diskimage_mbr.ml index 07f9df8..30c5dc4 100644 --- a/lib/diskimage_mbr.ml +++ b/lib/diskimage_mbr.ml @@ -26,10 +26,11 @@ open ExtList 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 @@ -47,8 +48,8 @@ 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 @@ -62,7 +63,7 @@ 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? *) @@ -116,11 +117,16 @@ and parse_mbr_entry dev i bits = 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; @@ -169,6 +175,7 @@ and probe_extended_partition max fd epart sect = else [] *) +(* (* Ugh, fake a UInt32 -> UInt64 conversion without sign extension, until * we get working UInt32/UInt64 modules in extlib. *) @@ -176,3 +183,4 @@ and uint64_of_int32 u32 = let i64 = Int64.of_int32 u32 in if u32 >= 0l then i64 else Int64.add i64 0x1_0000_0000_L +*) diff --git a/lib/diskimage_utils.ml b/lib/diskimage_utils.ml index cbd809f..4ad508d 100644 --- a/lib/diskimage_utils.ml +++ b/lib/diskimage_utils.ml @@ -20,41 +20,33 @@ 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 @@ -63,7 +55,7 @@ object (self) | [] -> 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 ); @@ -74,41 +66,42 @@ object (self) (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; @@ -127,14 +120,15 @@ object 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. *) @@ -146,8 +140,7 @@ object 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 @@ -156,9 +149,9 @@ let null_device : device = 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 @@ -205,16 +198,16 @@ and partition_content = 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. *) diff --git a/lib/diskimage_utils.mli b/lib/diskimage_utils.mli index d44f038..5e91520 100644 --- a/lib/diskimage_utils.mli +++ b/lib/diskimage_utils.mli @@ -25,42 +25,42 @@ val debug : bool ref 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 @@ -106,16 +106,16 @@ and partition_content = 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 = { @@ -142,14 +142,3 @@ val range : int -> int -> int list (** [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. *) diff --git a/virt-df/.depend b/virt-df/.depend index 793019d..e16c2b2 100644 --- a/virt-df/.depend +++ b/virt-df/.depend @@ -1,6 +1,8 @@ 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 diff --git a/virt-df/virt_df_main.ml b/virt-df/virt_df_main.ml index cfe40e2..4572099 100644 --- a/virt-df/virt_df_main.ml +++ b/virt-df/virt_df_main.ml @@ -23,19 +23,11 @@ open ExtList 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 @@ -275,12 +267,12 @@ OPTIONS" 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. *) @@ -350,31 +342,32 @@ OPTIONS" in 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" @@ -384,8 +377,10 @@ OPTIONS" in 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 ) ) @@ -411,14 +406,13 @@ OPTIONS" in 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. *) @@ -426,15 +420,15 @@ OPTIONS" in (* '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 -- 1.8.3.1