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.
27 class virtual device =
29 method virtual size : int63
30 method virtual name : string
31 method virtual blocksize : int63
32 method virtual map_block : int63 -> (device * int63) list
33 method virtual contiguous : Int63.t -> Int63.t
35 (* Block-based read. Inefficient so normally overridden in subclasses. *)
36 method read offset len =
37 if offset < ~^0 || len < ~^0 then
38 invalid_arg "device: read: negative offset or length";
40 let blocksize = self#blocksize in
42 (* Break the request into blocks.
43 * Find the first and last blocks of this request.
45 let first_blk = offset /^ blocksize in
46 let offset_in_first_blk = offset -^ first_blk *^ blocksize in
47 let last_blk = (offset +^ len -^ ~^1) /^ blocksize in
49 (* Buffer for the result. *)
50 let buf = Buffer.create (Int63.to_int len) in
52 let not_mapped_error () = invalid_arg "device: read: block not mapped" in
54 (* Copy the first block (partial). *)
55 (match self#map_block first_blk with
56 | [] -> not_mapped_error ()
59 min len (blocksize -^ offset_in_first_blk) in
60 let str = dev#read (base +^ offset_in_first_blk) len in
61 Buffer.add_string buf str
64 (* Copy the middle blocks. *)
66 if blk < last_blk then (
67 (match self#map_block blk with
68 | [] -> not_mapped_error ()
70 let str = dev#read ~^0 self#blocksize in
71 Buffer.add_string buf str
76 loop (Int63.succ first_blk);
78 (* Copy the last block (partial). *)
79 if first_blk < last_blk then (
80 match self#map_block last_blk with
81 | [] -> not_mapped_error ()
83 let len = (offset +^ len) -^ last_blk *^ blocksize in
84 let str = dev#read ~^0 len in
85 Buffer.add_string buf str
88 assert (Int63.to_int len = Buffer.length buf);
91 (* Helper method to read a chunk of data into a bitstring. *)
92 method read_bitstring offset len =
93 let str = self#read offset len in
94 (str, 0, String.length str lsl 3)
97 (* A concrete device which just direct-maps a file or /dev device. *)
98 class block_device filename blocksize =
99 let fd = openfile filename [ O_RDONLY ] 0 in
100 let size = Int63.of_int64 (LargeFile.fstat fd).LargeFile.st_size in
103 method read offset len =
104 let offset = Int63.to_int64 offset in
105 let len = Int63.to_int len in
106 ignore (LargeFile.lseek fd offset SEEK_SET);
107 let str = String.make len '\000' in
111 method name = filename
112 method blocksize = blocksize
113 method map_block _ = []
114 method contiguous offset =
116 method close () = close fd
119 (* A linear offset/size from an underlying device. *)
120 class offset_device name start size blocksize (dev : device) =
125 method read offset len =
126 if offset < ~^0 || len < ~^0 || offset +^ len > size then
128 sprintf "%s: tried to read outside device boundaries (%s/%s/%s)"
129 name (Int63.to_string offset) (Int63.to_string len)
130 (Int63.to_string size)
132 dev#read (start+^offset) len
133 method blocksize = blocksize
134 method map_block i = [dev, i *^ blocksize +^ start]
135 method contiguous offset =
139 (* A device with just a modified block size. *)
140 class blocksize_overlay new_blocksize (dev : device) =
143 method name = dev#name
144 method size = dev#size
145 method read = dev#read
146 method blocksize = new_blocksize
147 method map_block new_blk =
148 let orig_blk = new_blk *^ new_blocksize /^ dev#blocksize in
149 dev#map_block orig_blk
150 method contiguous offset = dev#size -^ offset
153 (* The null device. Any attempt to read generates an error. *)
154 let null_device : device =
157 method read _ _ = assert false
160 method blocksize = ~^1
161 method map_block _ = assert false
162 method contiguous _ = ~^0
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_dev : device; (* Partitions (whole) device. *)
190 parts : partition list (* Partitions. *)
193 part_status : partition_status; (* Bootable, etc. *)
194 part_type : int; (* Partition filesystem type. *)
195 part_dev : device; (* Partition device. *)
196 part_content : partition_content; (* What's on it. *)
198 and partition_status = Bootable | Nonbootable | Malformed | NullEntry
199 and partition_content =
200 [ `Unknown (* Not probed or unknown. *)
201 | `Filesystem of filesystem (* Filesystem. *)
202 | `PhysicalVolume of pv (* Contains an LVM PV. *)
205 (* Filesystems (also swap devices). *)
207 fs_plugin_id : fs_plugin_id; (* Filesystem. *)
208 fs_dev : device; (* Device containing the filesystem. *)
209 fs_blocksize : int63; (* Block size (bytes). *)
210 fs_blocks_total : int63; (* Total blocks. *)
211 fs_is_swap : bool; (* If swap, following not valid. *)
212 fs_blocks_reserved : int63; (* Blocks reserved for super-user. *)
213 fs_blocks_avail : int63; (* Blocks free (available). *)
214 fs_blocks_used : int63; (* Blocks in use. *)
215 fs_inodes_total : int63; (* Total inodes. *)
216 fs_inodes_reserved : int63; (* Inodes reserved for super-user. *)
217 fs_inodes_avail : int63; (* Inodes free (available). *)
218 fs_inodes_used : int63; (* Inodes in use. *)
221 (* Physical volumes. *)
223 lvm_plugin_id : lvm_plugin_id; (* The LVM plug-in. *)
224 pv_dev : device; (* Device covering whole PV. *)
225 pv_uuid : string; (* UUID. *)
228 (* Logical volumes. *)
230 lv_dev : device; (* Logical volume device. *)
233 and parts_plugin_id = string
234 and fs_plugin_id = string
235 and lvm_plugin_id = string
237 (* Convert a UUID (containing '-' chars) to canonical form. *)
238 let canonical_uuid uuid =
239 let uuid' = String.make 32 ' ' in
241 for i = 0 to String.length uuid - 1 do
242 if !j >= 32 then invalid_arg "canonical_uuid";
244 if c <> '-' then ( uuid'.[!j] <- c; incr j )
246 if !j <> 32 then invalid_arg "canonical_uuid";
249 (* This version by Isaac Trotts. *)
250 let group_by ?(cmp = Pervasives.compare) ls =
253 (fun acc (day1, x1) ->
256 | (day2, ls2) :: acctl ->
258 then (day1, x1 :: ls2) :: acctl
259 else (day1, [x1]) :: acc)
263 let ls' = List.rev ls' in
264 List.map (fun (x, xs) -> x, List.rev xs) ls'
266 let rec uniq ?(cmp = Pervasives.compare) = function
269 | x :: y :: xs when cmp x y = 0 ->
274 let sort_uniq ?cmp xs =
275 let xs = ExtList.List.sort ?cmp xs in
276 let xs = uniq ?cmp xs in
280 if a < b then a :: range (a+1) b