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 mapblock : int63 -> (device * int63) list
  33
  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";
  38
  39     let blocksize = self#blocksize in
  40
  41     (* Break the request into blocks.
  42      * Find the first and last blocks of this request.
  43      *)
  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
  47
  48     (* Buffer for the result. *)
  49     let buf = Buffer.create (Int63.to_int len) in
  50
  51     let not_mapped_error () = invalid_arg "device: read: block not mapped" in
  52
  53     (* Copy the first block (partial). *)
  54     (match self#mapblock first_blk with
  55      | [] -> not_mapped_error ()
  56      | (dev, base) :: _ ->
  57          let len =
  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
  61     );
  62
  63     (* Copy the middle blocks. *)
  64     let rec loop blk =
  65       if blk < last_blk then (
  66         (match self#mapblock blk with
  67          | [] -> not_mapped_error ()
  68          | (dev, base) :: _ ->
  69              let str = dev#read ~^0 self#blocksize in
  70              Buffer.add_string buf str
  71         );
  72         loop (Int63.succ blk)
  73       )
  74     in
  75     loop (Int63.succ first_blk);
  76
  77     (* Copy the last block (partial). *)
  78     if first_blk < last_blk then (
  79       match self#mapblock last_blk with
  80       | [] -> not_mapped_error ()
  81       | (dev, base) :: _ ->
  82           let len = (offset +^ len) -^ last_blk *^ blocksize in
  83           let str = dev#read ~^0 len in
  84           Buffer.add_string buf str
  85     );
  86
  87     assert (Int63.to_int len = Buffer.length buf);
  88     Buffer.contents buf
  89
  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)
  94 end
  95
  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
 100 object (self)
 101   inherit device
 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
 107     read fd str 0 len;
 108     str
 109   method size = size
 110   method name = filename
 111   method blocksize = blocksize
 112   method mapblock _ = []
 113   method close () = close fd
 114 end
 115
 116 (* A linear offset/size from an underlying device. *)
 117 class offset_device name start size blocksize (dev : device) =
 118 object
 119   inherit device
 120   method name = name
 121   method size = size
 122   method read offset len =
 123     if offset < ~^0 || len < ~^0 || offset +^ len > size then
 124       invalid_arg (
 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)
 128       );
 129     dev#read (start+^offset) len
 130   method blocksize = blocksize
 131   method mapblock i = [dev, i *^ blocksize +^ start]
 132 end
 133
 134 (* A device with just a modified block size. *)
 135 class blocksize_overlay new_blocksize (dev : device) =
 136 object
 137   inherit 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
 145 end
 146
 147 (* The null device.  Any attempt to read generates an error. *)
 148 let null_device : device =
 149 object
 150   inherit device
 151   method read _ _ = assert false
 152   method size = ~^0
 153   method name = "null"
 154   method blocksize = ~^1
 155   method mapblock _ = assert false
 156 end
 157
 158 type machine = {
 159   m_name : string;                      (* Machine name. *)
 160   m_disks : disk list;                  (* Machine disks. *)
 161   m_lv_filesystems :
 162     (lv * filesystem) list;             (* Machine LV filesystems. *)
 163 }
 164 and disk = {
 165   d_name : string;                      (* Device name (eg "hda") *)
 166
 167   (* About the device itself. *)
 168   d_dev : block_device;                 (* Disk device. *)
 169   d_content : disk_content;             (* What's on it. *)
 170 }
 171 and disk_content =
 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. *)
 176   ]
 177
 178 (* Partitions. *)
 179
 180 and partitions = {
 181   parts_plugin_id : parts_plugin_id;    (* Partitioning scheme. *)
 182   parts : partition list                (* Partitions. *)
 183 }
 184 and partition = {
 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. *)
 189 }
 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. *)
 195   ]
 196
 197 (* Filesystems (also swap devices). *)
 198 and filesystem = {
 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. *)
 211 }
 212
 213 (* Physical volumes. *)
 214 and pv = {
 215   lvm_plugin_id : lvm_plugin_id;        (* The LVM plug-in. *)
 216   pv_uuid : string;                     (* UUID. *)
 217 }
 218
 219 (* Logical volumes. *)
 220 and lv = {
 221   lv_dev : device;                      (* Logical volume device. *)
 222 }
 223
 224 and parts_plugin_id = string
 225 and fs_plugin_id = string
 226 and lvm_plugin_id = string
 227
 228 (* Convert a UUID (containing '-' chars) to canonical form. *)
 229 let canonical_uuid uuid =
 230   let uuid' = String.make 32 ' ' in
 231   let j = ref 0 in
 232   for i = 0 to String.length uuid - 1 do
 233     if !j >= 32 then invalid_arg "canonical_uuid";
 234     let c = uuid.[i] in
 235     if c <> '-' then ( uuid'.[!j] <- c; incr j )
 236   done;
 237   if !j <> 32 then invalid_arg "canonical_uuid";
 238   uuid'
 239
 240 (* This version by Isaac Trotts. *)
 241 let group_by ?(cmp = Pervasives.compare) ls =
 242   let ls' =
 243     List.fold_left
 244       (fun acc (day1, x1) ->
 245          match acc with
 246              [] -> [day1, [x1]]
 247            | (day2, ls2) :: acctl ->
 248                if cmp day1 day2 = 0
 249                then (day1, x1 :: ls2) :: acctl
 250                else (day1, [x1]) :: acc)
 251       []
 252       ls
 253   in
 254   let ls' = List.rev ls' in
 255   List.map (fun (x, xs) -> x, List.rev xs) ls'
 256
 257 let rec range a b =
 258   if a < b then a :: range (a+1) b
 259   else []