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 (* The null device.  Any attempt to read generates an error. *)
 141 let null_device : device =
 142 object
 143   inherit device
 144   method read _ _ = assert false
 145   method size = 0L
 146   method name = "null"
 147   method blocksize = 1
 148   method mapblock _ = assert false
 149 end
 150
 151 type machine = {
 152   m_name : string;                      (* Machine name. *)
 153   m_disks : disk list;                  (* Machine disks. *)
 154   m_lv_filesystems :
 155     (lv * filesystem) list;             (* Machine LV filesystems. *)
 156 }
 157 and disk = {
 158   d_name : string;                      (* Device name (eg "hda") *)
 159
 160   (* About the device itself. *)
 161   d_dev : block_device;                 (* Disk device. *)
 162   d_content : disk_content;             (* What's on it. *)
 163 }
 164 and disk_content =
 165   [ `Unknown                            (* Not probed or unknown. *)
 166   | `Partitions of partitions           (* Contains partitions. *)
 167   | `Filesystem of filesystem           (* Contains a filesystem directly. *)
 168   | `PhysicalVolume of pv               (* Contains an LVM PV. *)
 169   ]
 170
 171 (* Partitions. *)
 172
 173 and partitions = {
 174   parts_plugin_id : parts_plugin_id;    (* Partitioning scheme. *)
 175   parts : partition list                (* Partitions. *)
 176 }
 177 and partition = {
 178   part_status : partition_status;       (* Bootable, etc. *)
 179   part_type : int;                      (* Partition filesystem type. *)
 180   part_dev : device;                    (* Partition device. *)
 181   part_content : partition_content;     (* What's on it. *)
 182 }
 183 and partition_status = Bootable | Nonbootable | Malformed | NullEntry
 184 and partition_content =
 185   [ `Unknown                            (* Not probed or unknown. *)
 186   | `Filesystem of filesystem           (* Filesystem. *)
 187   | `PhysicalVolume of pv               (* Contains an LVM PV. *)
 188   ]
 189
 190 (* Filesystems (also swap devices). *)
 191 and filesystem = {
 192   fs_plugin_id : fs_plugin_id;          (* Filesystem. *)
 193   fs_block_size : int64;                (* Block size (bytes). *)
 194   fs_blocks_total : int64;              (* Total blocks. *)
 195   fs_is_swap : bool;                    (* If swap, following not valid. *)
 196   fs_blocks_reserved : int64;           (* Blocks reserved for super-user. *)
 197   fs_blocks_avail : int64;              (* Blocks free (available). *)
 198   fs_blocks_used : int64;               (* Blocks in use. *)
 199   fs_inodes_total : int64;              (* Total inodes. *)
 200   fs_inodes_reserved : int64;           (* Inodes reserved for super-user. *)
 201   fs_inodes_avail : int64;              (* Inodes free (available). *)
 202   fs_inodes_used : int64;               (* Inodes in use. *)
 203 }
 204
 205 (* Physical volumes. *)
 206 and pv = {
 207   lvm_plugin_id : lvm_plugin_id;        (* The LVM plug-in. *)
 208   pv_uuid : string;                     (* UUID. *)
 209 }
 210
 211 (* Logical volumes. *)
 212 and lv = {
 213   lv_dev : device;                      (* Logical volume device. *)
 214 }
 215
 216 and parts_plugin_id = string
 217 and fs_plugin_id = string
 218 and lvm_plugin_id = string
 219
 220 (* Convert a UUID (containing '-' chars) to canonical form. *)
 221 let canonical_uuid uuid =
 222   let uuid' = String.make 32 ' ' in
 223   let j = ref 0 in
 224   for i = 0 to String.length uuid - 1 do
 225     if !j >= 32 then invalid_arg "canonical_uuid";
 226     let c = uuid.[i] in
 227     if c <> '-' then ( uuid'.[!j] <- c; incr j )
 228   done;
 229   if !j <> 32 then invalid_arg "canonical_uuid";
 230   uuid'
 231
 232 (* This version by Isaac Trotts. *)
 233 let group_by ?(cmp = Pervasives.compare) ls =
 234   let ls' =
 235     List.fold_left
 236       (fun acc (day1, x1) ->
 237          match acc with
 238              [] -> [day1, [x1]]
 239            | (day2, ls2) :: acctl ->
 240                if cmp day1 day2 = 0
 241                then (day1, x1 :: ls2) :: acctl
 242                else (day1, [x1]) :: acc)
 243       []
 244       ls
 245   in
 246   let ls' = List.rev ls' in
 247   List.map (fun (x, xs) -> x, List.rev xs) ls'
 248
 249 let rec range a b =
 250   if a < b then a :: range (a+1) b
 251   else []