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 mapblock : int63 -> (device * int63) list
34 (* Block-based read. Inefficient so normally overridden in subclasses. *)
35 method read offset len =
36 if offset < ~^0 || len < ~^0 then
37 invalid_arg "device: read: negative offset or length";
39 let blocksize = self#blocksize in
41 (* Break the request into blocks.
42 * Find the first and last blocks of this request.
44 let first_blk = offset /^ blocksize in
45 let offset_in_first_blk = offset -^ first_blk *^ blocksize in
46 let last_blk = (offset +^ len -^ ~^1) /^ blocksize in
48 (* Buffer for the result. *)
49 let buf = Buffer.create (Int63.to_int len) in
51 let not_mapped_error () = invalid_arg "device: read: block not mapped" in
53 (* Copy the first block (partial). *)
54 (match self#mapblock first_blk with
55 | [] -> not_mapped_error ()
58 min len (blocksize -^ offset_in_first_blk) in
59 let str = dev#read (base +^ offset_in_first_blk) len in
60 Buffer.add_string buf str
63 (* Copy the middle blocks. *)
65 if blk < last_blk then (
66 (match self#mapblock blk with
67 | [] -> not_mapped_error ()
69 let str = dev#read ~^0 self#blocksize in
70 Buffer.add_string buf str
75 loop (Int63.succ first_blk);
77 (* Copy the last block (partial). *)
78 if first_blk < last_blk then (
79 match self#mapblock last_blk with
80 | [] -> not_mapped_error ()
82 let len = (offset +^ len) -^ last_blk *^ blocksize in
83 let str = dev#read ~^0 len in
84 Buffer.add_string buf str
87 assert (Int63.to_int len = Buffer.length buf);
90 (* Helper method to read a chunk of data into a bitstring. *)
91 method read_bitstring offset len =
92 let str = self#read offset len in
93 (str, 0, String.length str lsl 3)
96 (* A concrete device which just direct-maps a file or /dev device. *)
97 class block_device filename blocksize =
98 let fd = openfile filename [ O_RDONLY ] 0 in
99 let size = Int63.of_int64 (LargeFile.fstat fd).LargeFile.st_size in
102 method read offset len =
103 let offset = Int63.to_int64 offset in
104 let len = Int63.to_int len in
105 ignore (LargeFile.lseek fd offset SEEK_SET);
106 let str = String.make len '\000' in
110 method name = filename
111 method blocksize = blocksize
112 method mapblock _ = []
113 method close () = close fd
116 (* A linear offset/size from an underlying device. *)
117 class offset_device name start size blocksize (dev : device) =
122 method read offset len =
123 if offset < ~^0 || len < ~^0 || offset +^ len > size then
125 sprintf "%s: tried to read outside device boundaries (%s/%s/%s)"
126 name (Int63.to_string offset) (Int63.to_string len)
127 (Int63.to_string size)
129 dev#read (start+^offset) len
130 method blocksize = blocksize
131 method mapblock i = [dev, i *^ blocksize +^ start]
134 (* A device with just a modified block size. *)
135 class blocksize_overlay new_blocksize (dev : device) =
138 method name = dev#name
139 method size = dev#size
140 method read offset len = dev#read offset len
141 method blocksize = new_blocksize
142 method mapblock new_blk =
143 let orig_blk = new_blk *^ new_blocksize /^ dev#blocksize in
144 dev#mapblock orig_blk
147 (* The null device. Any attempt to read generates an error. *)
148 let null_device : device =
151 method read _ _ = assert false
154 method blocksize = ~^1
155 method mapblock _ = assert false
159 m_name : string; (* Machine name. *)
160 m_disks : disk list; (* Machine disks. *)
162 (lv * filesystem) list; (* Machine LV filesystems. *)
165 d_name : string; (* Device name (eg "hda") *)
167 (* About the device itself. *)
168 d_dev : block_device; (* Disk device. *)
169 d_content : disk_content; (* What's on it. *)
172 [ `Unknown (* Not probed or unknown. *)
173 | `Partitions of partitions (* Contains partitions. *)
174 | `Filesystem of filesystem (* Contains a filesystem directly. *)
175 | `PhysicalVolume of pv (* Contains an LVM PV. *)
181 parts_plugin_id : parts_plugin_id; (* Partitioning scheme. *)
182 parts : partition list (* Partitions. *)
185 part_status : partition_status; (* Bootable, etc. *)
186 part_type : int; (* Partition filesystem type. *)
187 part_dev : device; (* Partition device. *)
188 part_content : partition_content; (* What's on it. *)
190 and partition_status = Bootable | Nonbootable | Malformed | NullEntry
191 and partition_content =
192 [ `Unknown (* Not probed or unknown. *)
193 | `Filesystem of filesystem (* Filesystem. *)
194 | `PhysicalVolume of pv (* Contains an LVM PV. *)
197 (* Filesystems (also swap devices). *)
199 fs_plugin_id : fs_plugin_id; (* Filesystem. *)
200 fs_dev : device; (* Device containing the filesystem. *)
201 fs_blocksize : int63; (* Block size (bytes). *)
202 fs_blocks_total : int63; (* Total blocks. *)
203 fs_is_swap : bool; (* If swap, following not valid. *)
204 fs_blocks_reserved : int63; (* Blocks reserved for super-user. *)
205 fs_blocks_avail : int63; (* Blocks free (available). *)
206 fs_blocks_used : int63; (* Blocks in use. *)
207 fs_inodes_total : int63; (* Total inodes. *)
208 fs_inodes_reserved : int63; (* Inodes reserved for super-user. *)
209 fs_inodes_avail : int63; (* Inodes free (available). *)
210 fs_inodes_used : int63; (* Inodes in use. *)
213 (* Physical volumes. *)
215 lvm_plugin_id : lvm_plugin_id; (* The LVM plug-in. *)
216 pv_uuid : string; (* UUID. *)
219 (* Logical volumes. *)
221 lv_dev : device; (* Logical volume device. *)
224 and parts_plugin_id = string
225 and fs_plugin_id = string
226 and lvm_plugin_id = string
228 (* Convert a UUID (containing '-' chars) to canonical form. *)
229 let canonical_uuid uuid =
230 let uuid' = String.make 32 ' ' in
232 for i = 0 to String.length uuid - 1 do
233 if !j >= 32 then invalid_arg "canonical_uuid";
235 if c <> '-' then ( uuid'.[!j] <- c; incr j )
237 if !j <> 32 then invalid_arg "canonical_uuid";
240 (* This version by Isaac Trotts. *)
241 let group_by ?(cmp = Pervasives.compare) ls =
244 (fun acc (day1, x1) ->
247 | (day2, ls2) :: acctl ->
249 then (day1, x1 :: ls2) :: acctl
250 else (day1, [x1]) :: acc)
254 let ls' = List.rev ls' in
255 List.map (fun (x, xs) -> x, List.rev xs) ls'
258 if a < b then a :: range (a+1) b