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 let debug = ref false
  24
  25 let ( +* ) = Int32.add
  26 let ( -* ) = Int32.sub
  27 let ( ** ) = Int32.mul
  28 let ( /* ) = Int32.div
  29
  30 let ( +^ ) = Int64.add
  31 let ( -^ ) = Int64.sub
  32 let ( *^ ) = Int64.mul
  33 let ( /^ ) = Int64.div
  34
  35 class virtual device =
  36 object (self)
  37   method virtual size : int64
  38   method virtual name : string
  39   method virtual blocksize : int
  40   method virtual mapblock : int64 -> (device * int64) list
  41
  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";
  46
  47     let blocksize64 = Int64.of_int self#blocksize in
  48
  49     (* Break the request into blocks.
  50      * Find the first and last blocks of this request.
  51      *)
  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
  55
  56     (* Buffer for the result. *)
  57     let buf = Buffer.create len in
  58
  59     let not_mapped_error () = invalid_arg "device: read: block not mapped" in
  60
  61     (* Copy the first block (partial). *)
  62     (match self#mapblock first_blk with
  63      | [] -> not_mapped_error ()
  64      | (dev, base) :: _ ->
  65          let len =
  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
  69     );
  70
  71     (* Copy the middle blocks. *)
  72     let rec loop blk =
  73       if blk < last_blk then (
  74         (match self#mapblock blk with
  75          | [] -> not_mapped_error ()
  76          | (dev, base) :: _ ->
  77              let str = dev#read 0L self#blocksize in
  78              Buffer.add_string buf str
  79         );
  80         loop (Int64.succ blk)
  81       )
  82     in
  83     loop (Int64.succ first_blk);
  84
  85     (* Copy the last block (partial). *)
  86     if first_blk < last_blk then (
  87       match self#mapblock last_blk with
  88       | [] -> not_mapped_error ()
  89       | (dev, base) :: _ ->
  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
  94     );
  95
  96     assert (len = Buffer.length buf);
  97     Buffer.contents buf
  98
  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
 102     (str, 0, len * 8)
 103 end
 104
 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
 109 object (self)
 110   inherit device
 111   method read offset len =
 112     ignore (LargeFile.lseek fd offset SEEK_SET);
 113     let str = String.make len '\000' in
 114     read fd str 0 len;
 115     str
 116   method size = size
 117   method name = filename
 118   method blocksize = blocksize
 119   method mapblock _ = []
 120   method close () = close fd
 121 end
 122
 123 (* A linear offset/size from an underlying device. *)
 124 class offset_device name start size blocksize (dev : device) =
 125 object
 126   inherit device
 127   method name = name
 128   method size = size
 129   method read offset len =
 130     if offset < 0L || len < 0 || offset +^ Int64.of_int len > size then
 131       invalid_arg (
 132         sprintf "%s: tried to read outside device boundaries (%Ld/%d/%Ld)"
 133           name offset len size
 134       );
 135     dev#read (start+^offset) len
 136   method blocksize = blocksize
 137   method mapblock i = [dev, i *^ Int64.of_int blocksize +^ start]
 138 end
 139
 140 (* A device with just a modified block size. *)
 141 class blocksize_overlay new_blocksize (dev : device) =
 142 object
 143   inherit 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 =
 149     let orig_blk =
 150       new_blk *^ Int64.of_int new_blocksize /^ Int64.of_int dev#blocksize in
 151     dev#mapblock orig_blk
 152 end
 153
 154 (* The null device.  Any attempt to read generates an error. *)
 155 let null_device : device =
 156 object
 157   inherit device
 158   method read _ _ = assert false
 159   method size = 0L
 160   method name = "null"
 161   method blocksize = 1
 162   method mapblock _ = assert false
 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 : partition list                (* Partitions. *)
 190 }
 191 and partition = {
 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. *)
 196 }
 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. *)
 202   ]
 203
 204 (* Filesystems (also swap devices). *)
 205 and filesystem = {
 206   fs_plugin_id : fs_plugin_id;          (* Filesystem. *)
 207   fs_dev : device;                      (* Device containing the filesystem. *)
 208   fs_blocksize : int;                   (* 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. *)
 218 }
 219
 220 (* Physical volumes. *)
 221 and pv = {
 222   lvm_plugin_id : lvm_plugin_id;        (* The LVM plug-in. *)
 223   pv_uuid : string;                     (* UUID. *)
 224 }
 225
 226 (* Logical volumes. *)
 227 and lv = {
 228   lv_dev : device;                      (* Logical volume device. *)
 229 }
 230
 231 and parts_plugin_id = string
 232 and fs_plugin_id = string
 233 and lvm_plugin_id = string
 234
 235 (* Convert a UUID (containing '-' chars) to canonical form. *)
 236 let canonical_uuid uuid =
 237   let uuid' = String.make 32 ' ' in
 238   let j = ref 0 in
 239   for i = 0 to String.length uuid - 1 do
 240     if !j >= 32 then invalid_arg "canonical_uuid";
 241     let c = uuid.[i] in
 242     if c <> '-' then ( uuid'.[!j] <- c; incr j )
 243   done;
 244   if !j <> 32 then invalid_arg "canonical_uuid";
 245   uuid'
 246
 247 (* This version by Isaac Trotts. *)
 248 let group_by ?(cmp = Pervasives.compare) ls =
 249   let ls' =
 250     List.fold_left
 251       (fun acc (day1, x1) ->
 252          match acc with
 253              [] -> [day1, [x1]]
 254            | (day2, ls2) :: acctl ->
 255                if cmp day1 day2 = 0
 256                then (day1, x1 :: ls2) :: acctl
 257                else (day1, [x1]) :: acc)
 258       []
 259       ls
 260   in
 261   let ls' = List.rev ls' in
 262   List.map (fun (x, xs) -> x, List.rev xs) ls'
 263
 264 let rec range a b =
 265   if a < b then a :: range (a+1) b
 266   else []