1 (* Diskimage library for reading disk images.
2 (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
5 This program is free software; you can redistribute it and/or modify
6 it under the terms of the GNU General Public License as published by
7 the Free Software Foundation; either version 2 of the License, or
8 (at your option) any later version.
10 This program is distributed in the hope that it will be useful,
11 but WITHOUT ANY WARRANTY; without even the implied warranty of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 GNU General Public License for more details.
15 You should have received a copy of the GNU General Public License
16 along with this program; if not, write to the Free Software
17 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
25 let ( +* ) = Int32.add
26 let ( -* ) = Int32.sub
27 let ( ** ) = Int32.mul
28 let ( /* ) = Int32.div
30 let ( +^ ) = Int64.add
31 let ( -^ ) = Int64.sub
32 let ( *^ ) = Int64.mul
33 let ( /^ ) = Int64.div
35 class virtual device =
37 method virtual size : int64
38 method virtual name : string
39 method virtual blocksize : int
40 method virtual mapblock : int64 -> (device * int64) list
42 (* Block-based read. Inefficient so normally overridden in subclasses. *)
43 method read offset len =
44 if offset < 0L || len < 0 then
45 invalid_arg "device: read: negative offset or length";
47 let blocksize64 = Int64.of_int self#blocksize in
49 (* Break the request into blocks.
50 * Find the first and last blocks of this request.
52 let first_blk = offset /^ blocksize64 in
53 let offset_in_first_blk = offset -^ first_blk *^ blocksize64 in
54 let last_blk = (offset +^ Int64.of_int (len-1)) /^ blocksize64 in
56 (* Buffer for the result. *)
57 let buf = Buffer.create len in
59 let not_mapped_error () = invalid_arg "device: read: block not mapped" in
61 (* Copy the first block (partial). *)
62 (match self#mapblock first_blk with
63 | [] -> not_mapped_error ()
66 min len (Int64.to_int (blocksize64 -^ offset_in_first_blk)) in
67 let str = dev#read (base +^ offset_in_first_blk) len in
68 Buffer.add_string buf str
71 (* Copy the middle blocks. *)
73 if blk < last_blk then (
74 (match self#mapblock blk with
75 | [] -> not_mapped_error ()
77 let str = dev#read 0L self#blocksize in
78 Buffer.add_string buf str
83 loop (Int64.succ first_blk);
85 (* Copy the last block (partial). *)
86 if first_blk < last_blk then (
87 match self#mapblock last_blk with
88 | [] -> not_mapped_error ()
90 let len = (offset +^ Int64.of_int len) -^ last_blk *^ blocksize64 in
91 let len = Int64.to_int len in
92 let str = dev#read 0L len in
93 Buffer.add_string buf str
96 assert (len = Buffer.length buf);
99 (* Helper method to read a chunk of data into a bitstring. *)
100 method read_bitstring offset len =
101 let str = self#read offset len in
105 (* A concrete device which just direct-maps a file or /dev device. *)
106 class block_device filename blocksize =
107 let fd = openfile filename [ O_RDONLY ] 0 in
108 let size = (LargeFile.fstat fd).LargeFile.st_size in
111 method read offset len =
112 ignore (LargeFile.lseek fd offset SEEK_SET);
113 let str = String.make len '\000' in
117 method name = filename
118 method blocksize = blocksize
119 method mapblock _ = []
120 method close () = close fd
123 (* A linear offset/size from an underlying device. *)
124 class offset_device name start size blocksize (dev : device) =
129 method read offset len =
130 if offset < 0L || len < 0 || offset +^ Int64.of_int len > size then
132 sprintf "%s: tried to read outside device boundaries (%Ld/%d/%Ld)"
135 dev#read (start+^offset) len
136 method blocksize = blocksize
137 method mapblock i = [dev, i *^ Int64.of_int blocksize +^ start]
140 (* A device with just a modified block size. *)
141 class blocksize_overlay new_blocksize (dev : device) =
144 method name = dev#name
145 method size = dev#size
146 method read offset len = dev#read offset len
147 method blocksize = new_blocksize
148 method mapblock new_blk =
150 new_blk *^ Int64.of_int new_blocksize /^ Int64.of_int dev#blocksize in
151 dev#mapblock orig_blk
154 (* The null device. Any attempt to read generates an error. *)
155 let null_device : device =
158 method read _ _ = assert false
162 method mapblock _ = assert false
166 m_name : string; (* Machine name. *)
167 m_disks : disk list; (* Machine disks. *)
169 (lv * filesystem) list; (* Machine LV filesystems. *)
172 d_name : string; (* Device name (eg "hda") *)
174 (* About the device itself. *)
175 d_dev : block_device; (* Disk device. *)
176 d_content : disk_content; (* What's on it. *)
179 [ `Unknown (* Not probed or unknown. *)
180 | `Partitions of partitions (* Contains partitions. *)
181 | `Filesystem of filesystem (* Contains a filesystem directly. *)
182 | `PhysicalVolume of pv (* Contains an LVM PV. *)
188 parts_plugin_id : parts_plugin_id; (* Partitioning scheme. *)
189 parts : partition list (* Partitions. *)
192 part_status : partition_status; (* Bootable, etc. *)
193 part_type : int; (* Partition filesystem type. *)
194 part_dev : device; (* Partition device. *)
195 part_content : partition_content; (* What's on it. *)
197 and partition_status = Bootable | Nonbootable | Malformed | NullEntry
198 and partition_content =
199 [ `Unknown (* Not probed or unknown. *)
200 | `Filesystem of filesystem (* Filesystem. *)
201 | `PhysicalVolume of pv (* Contains an LVM PV. *)
204 (* Filesystems (also swap devices). *)
206 fs_dev : device; (* Device containing the filesystem. *)
207 fs_plugin_id : fs_plugin_id; (* Filesystem. *)
208 fs_block_size : int64; (* Block size (bytes). *)
209 fs_blocks_total : int64; (* Total blocks. *)
210 fs_is_swap : bool; (* If swap, following not valid. *)
211 fs_blocks_reserved : int64; (* Blocks reserved for super-user. *)
212 fs_blocks_avail : int64; (* Blocks free (available). *)
213 fs_blocks_used : int64; (* Blocks in use. *)
214 fs_inodes_total : int64; (* Total inodes. *)
215 fs_inodes_reserved : int64; (* Inodes reserved for super-user. *)
216 fs_inodes_avail : int64; (* Inodes free (available). *)
217 fs_inodes_used : int64; (* Inodes in use. *)
220 (* Physical volumes. *)
222 lvm_plugin_id : lvm_plugin_id; (* The LVM plug-in. *)
223 pv_uuid : string; (* UUID. *)
226 (* Logical volumes. *)
228 lv_dev : device; (* Logical volume device. *)
231 and parts_plugin_id = string
232 and fs_plugin_id = string
233 and lvm_plugin_id = string
235 (* Convert a UUID (containing '-' chars) to canonical form. *)
236 let canonical_uuid uuid =
237 let uuid' = String.make 32 ' ' in
239 for i = 0 to String.length uuid - 1 do
240 if !j >= 32 then invalid_arg "canonical_uuid";
242 if c <> '-' then ( uuid'.[!j] <- c; incr j )
244 if !j <> 32 then invalid_arg "canonical_uuid";
247 (* This version by Isaac Trotts. *)
248 let group_by ?(cmp = Pervasives.compare) ls =
251 (fun acc (day1, x1) ->
254 | (day2, ls2) :: acctl ->
256 then (day1, x1 :: ls2) :: acctl
257 else (day1, [x1]) :: acc)
261 let ls' = List.rev ls' in
262 List.map (fun (x, xs) -> x, List.rev xs) ls'
265 if a < b then a :: range (a+1) b