Added functions sort_uniq and uniq.
[virt-df.git] / lib / diskimage_utils.ml
1 (* Diskimage library for reading disk images.
2    (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
3    http://libvirt.org/
4
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.
9
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.
14
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.
18  *)
19
20 open Printf
21 open Unix
22
23 open Int63.Operators
24
25 let debug = ref false
26
27 class virtual device =
28 object (self)
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
34
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";
39
40     let blocksize = self#blocksize in
41
42     (* Break the request into blocks.
43      * Find the first and last blocks of this request.
44      *)
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
48
49     (* Buffer for the result. *)
50     let buf = Buffer.create (Int63.to_int len) in
51
52     let not_mapped_error () = invalid_arg "device: read: block not mapped" in
53
54     (* Copy the first block (partial). *)
55     (match self#map_block first_blk with
56      | [] -> not_mapped_error ()
57      | (dev, base) :: _ ->
58          let len =
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
62     );
63
64     (* Copy the middle blocks. *)
65     let rec loop blk =
66       if blk < last_blk then (
67         (match self#map_block blk with
68          | [] -> not_mapped_error ()
69          | (dev, base) :: _ ->
70              let str = dev#read ~^0 self#blocksize in
71              Buffer.add_string buf str
72         );
73         loop (Int63.succ blk)
74       )
75     in
76     loop (Int63.succ first_blk);
77
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 ()
82       | (dev, base) :: _ ->
83           let len = (offset +^ len) -^ last_blk *^ blocksize in
84           let str = dev#read ~^0 len in
85           Buffer.add_string buf str
86     );
87
88     assert (Int63.to_int len = Buffer.length buf);
89     Buffer.contents buf
90
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)
95 end
96
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
101 object (self)
102   inherit device
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
108     read fd str 0 len;
109     str
110   method size = size
111   method name = filename
112   method blocksize = blocksize
113   method map_block _ = []
114   method contiguous offset =
115     size -^ offset
116   method close () = close fd
117 end
118
119 (* A linear offset/size from an underlying device. *)
120 class offset_device name start size blocksize (dev : device) =
121 object
122   inherit device
123   method name = name
124   method size = size
125   method read offset len =
126     if offset < ~^0 || len < ~^0 || offset +^ len > size then
127       invalid_arg (
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)
131       );
132     dev#read (start+^offset) len
133   method blocksize = blocksize
134   method map_block i = [dev, i *^ blocksize +^ start]
135   method contiguous offset =
136     size -^ offset
137 end
138
139 (* A device with just a modified block size. *)
140 class blocksize_overlay new_blocksize (dev : device) =
141 object
142   inherit 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
151 end
152
153 (* The null device.  Any attempt to read generates an error. *)
154 let null_device : device =
155 object
156   inherit device
157   method read _ _ = assert false
158   method size = ~^0
159   method name = "null"
160   method blocksize = ~^1
161   method map_block _ = assert false
162   method contiguous _ = ~^0
163 end
164
165 type machine = {
166   m_name : string;                      (* Machine name. *)
167   m_disks : disk list;                  (* Machine disks. *)
168   m_lv_filesystems :
169     (lv * filesystem) list;             (* Machine LV filesystems. *)
170 }
171 and disk = {
172   d_name : string;                      (* Device name (eg "hda") *)
173
174   (* About the device itself. *)
175   d_dev : block_device;                 (* Disk device. *)
176   d_content : disk_content;             (* What's on it. *)
177 }
178 and disk_content =
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. *)
183   ]
184
185 (* Partitions. *)
186
187 and partitions = {
188   parts_plugin_id : parts_plugin_id;    (* Partitioning scheme. *)
189   parts_dev : device;                   (* Partitions (whole) device. *)
190   parts : partition list                (* Partitions. *)
191 }
192 and partition = {
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. *)
197 }
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. *)
203   ]
204
205 (* Filesystems (also swap devices). *)
206 and filesystem = {
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. *)
219 }
220
221 (* Physical volumes. *)
222 and pv = {
223   lvm_plugin_id : lvm_plugin_id;        (* The LVM plug-in. *)
224   pv_dev : device;                      (* Device covering whole PV. *)
225   pv_uuid : string;                     (* UUID. *)
226 }
227
228 (* Logical volumes. *)
229 and lv = {
230   lv_dev : device;                      (* Logical volume device. *)
231 }
232
233 and parts_plugin_id = string
234 and fs_plugin_id = string
235 and lvm_plugin_id = string
236
237 (* Convert a UUID (containing '-' chars) to canonical form. *)
238 let canonical_uuid uuid =
239   let uuid' = String.make 32 ' ' in
240   let j = ref 0 in
241   for i = 0 to String.length uuid - 1 do
242     if !j >= 32 then invalid_arg "canonical_uuid";
243     let c = uuid.[i] in
244     if c <> '-' then ( uuid'.[!j] <- c; incr j )
245   done;
246   if !j <> 32 then invalid_arg "canonical_uuid";
247   uuid'
248
249 (* This version by Isaac Trotts. *)
250 let group_by ?(cmp = Pervasives.compare) ls =
251   let ls' =
252     List.fold_left
253       (fun acc (day1, x1) ->
254          match acc with
255              [] -> [day1, [x1]]
256            | (day2, ls2) :: acctl ->
257                if cmp day1 day2 = 0
258                then (day1, x1 :: ls2) :: acctl
259                else (day1, [x1]) :: acc)
260       []
261       ls
262   in
263   let ls' = List.rev ls' in
264   List.map (fun (x, xs) -> x, List.rev xs) ls'
265
266 let rec uniq ?(cmp = Pervasives.compare) = function
267   | [] -> []
268   | [x] -> [x]
269   | x :: y :: xs when cmp x y = 0 ->
270       uniq (x :: xs)
271   | x :: y :: xs ->
272       x :: uniq (y :: xs)
273
274 let sort_uniq ?cmp xs =
275   let xs = ExtList.List.sort ?cmp xs in
276   let xs = uniq ?cmp xs in
277   xs
278
279 let rec range a b =
280   if a < b then a :: range (a+1) b
281   else []