(** Diskimage library for reading disk images. *)
(* (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
   http://libvirt.org/

   This program is free software; you can redistribute it and/or modify
   it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 *)

(**
   {2 Examples}

{[
  let machine = open_machine "host" ["hda", "/dev/hda"] in
  let machine = scan_machine machine in
  (* do what you want with the scan results ... *)
  close_machine machine
]}
*)

(** {2 Device class and specialized subclasses} *)

class virtual device :
  object
    method virtual name : string
      (** Return some printable name for the device. *)

    method virtual size : Int63.t
      (** Return the size of the device in bytes.

	  Note: For some types of devices, the device may have
	  "holes", alignment requirements, etc. so this method doesn't
	  imply that every byte from [0..size-1] is readable. *)
    method read : Int63.t -> Int63.t -> string
      (** [read offset len] reads len bytes starting at offset.

	  Note: A default implementation is provided for [read],
	  but it is fairly inefficient because it uses {!map_block} to
	  map each block in the request. *)
    method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
      (** [read_bitstring] is the same as [read] but returns
	  a pa_bitmatch-style bitstring. *)

    method virtual blocksize : Int63.t
      (** [blocksize] returns the natural block size of the device. *)
    method virtual map_block : Int63.t -> (device * Int63.t) list
      (** [map_block] describes how a block in this device is
	  mapped down to any underlying device(s).

	  Returns [[]] (empty list) if there is no underlying
	  device for this block.  Otherwise returns a list of
	  [(device, byte-offset)] locations where this block is mapped.

	  Normally the returned list has length 1, but in cases
	  such as mirroring you can have the same block mapped
	  to several underlying devices. *)

    method virtual contiguous : Int63.t -> Int63.t
      (** [contiguous offset] returns the number of contiguous
	  {i bytes} starting at byte [offset] on this device,
	  before (eg.) end of device or some discontinuity in
	  the mapping table occurs.

	  This method and {!map_block} allow callers to determine how
	  high level blocks map to low level disk images efficiently
	  (complex striping and interleaving patterns can make the
	  process much less efficient however). *)
  end
  (**
     A virtual (or physical!) device, encapsulating any translation
     that has to be done to access the device.  eg. For partitions
     there is a simple offset, but for LVM you may need complicated
     table lookups.
     
     Note this very rare use of OOP in OCaml!
  *)

class block_device : string -> Int63.t ->
  object
    method name : string
    method size : Int63.t
    method read : Int63.t -> Int63.t -> string
    method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
    method blocksize : Int63.t
    method map_block : Int63.t -> (device * Int63.t) list
    method contiguous : Int63.t -> Int63.t
    method close : unit -> unit
      (** Close the device, freeing up the file descriptor. *)
  end
    (** A concrete device which just direct-maps a file or /dev device.

	Create the device with [new block_device filename blocksize]
	where [filename] is the path to the file or device and
	[blocksize] is the blocksize of the device. *)

class offset_device : string -> Int63.t -> Int63.t -> Int63.t -> device ->
  object
    method name : string
    method size : Int63.t
    method read : Int63.t -> Int63.t -> string
    method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
    method blocksize : Int63.t
    method map_block : Int63.t -> (device * Int63.t) list
    method contiguous : Int63.t -> Int63.t
  end
    (** A concrete device which maps a linear part of an underlying device.

	[new offset_device name start size blocksize dev] creates a new
	device which maps bytes from [start] to [start+size-1]
	of the underlying device [dev] (ie. in this device they
	appear as bytes [0] to [size-1]).

	Useful for things like partitions.
    *)

class blocksize_overlay : Int63.t -> device ->
  object
    method name : string
    method size : Int63.t
    method read : Int63.t -> Int63.t -> string
    method read_bitstring : Int63.t -> Int63.t -> Bitmatch.bitstring
    method blocksize : Int63.t
    method contiguous : Int63.t -> Int63.t
    method map_block : Int63.t -> (device * Int63.t) list
  end
    (** Change the blocksize of an existing device. *)

val null_device : device
    (** The null device.  Any attempt to read generates an error. *)

(**
   {2 Structures used to describe machines, disks, partitions and filesystems}

   {3 Machine/device model}

   The "machine/device model" that we currently understand looks
   like this:

{v
machines
  |
  \--- host partitions / disk image files
         ||
       guest block devices
         |
         +--> guest partitions (eg. using MBR)
         |      |
         \-(1)->+--- filesystems (eg. ext3)
                |
                \--- PVs for LVM
                       |||
                     VGs and LVs
v}

   (1) Filesystems and PVs may also appear directly on guest
   block devices.

   Partition schemes (eg. MBR) and filesystems register themselves
   with this main module and they are queried first to get an idea
   of the physical devices, partitions and filesystems potentially
   available to the guest.

   Volume management schemes (eg. LVM2) register themselves here
   and are called later with "spare" physical devices and partitions
   to see if they contain LVM data.  If this results in additional
   logical volumes then these are checked for filesystems.

   Swap space is considered to be a dumb filesystem for the purposes
   of this discussion.
*)

type machine = {
  m_name : string;			(** Machine name. *)
  m_disks : disk list;			(** Machine disks. *)
  m_lv_filesystems :
    (lv * filesystem) list;		(** Machine LV filesystems. *)
}
    (** A 'machine' is just a convenient holder for collections of disks. *)

and disk = {
  d_name : string;			(** Device name (eg "hda") *)
  d_dev : block_device;			(** Disk device. *)
  d_content : disk_content;		(** What's on it. *)
}
    (** A single physical disk image. *)

and disk_content =
    [ `Filesystem of filesystem		(** Contains a direct filesystem. *)
    | `Partitions of partitions		(** Contains partitions. *)
    | `PhysicalVolume of pv		(** Contains an LVM PV. *)
    | `Unknown				(** Not probed or unknown. *)
    ]

and partitions = {
  parts_cb : partitioner_callbacks;	(** Partitioning scheme. *)
  parts_dev : device;			(** Partitions (whole) device. *)
  parts : partition list;		(** Partitions. *)
}
and partition = {
  part_status : partition_status;	(** Bootable, etc. *)
  part_type : int;			(** Partition filesystem type. *)
  part_dev : device;			(** Partition device. *)
  part_content : partition_content;	(** What's on it. *)
}
    (** Partitions as found on a disk image. *)

and partition_status = Bootable | Nonbootable | Malformed | NullEntry
and partition_content =
    [ `Filesystem of filesystem		(** Filesystem. *)
    | `PhysicalVolume of pv		(** Contains an LVM PV. *)
    | `Unknown				(** Not probed or unknown. *)
    ]

and filesystem = {
  fs_cb : filesystem_callbacks;		(** Filesystem type. *)
  fs_dev : device;			(** Device containing the filesystem. *)
  fs_blocksize : Int63.t;		(** Block size (bytes). *)
  fs_blocks_total : Int63.t;		(** Total blocks. *)
  fs_is_swap : bool;			(** If swap, following not valid. *)
  fs_blocks_reserved : Int63.t;		(** Blocks reserved for super-user. *)
  fs_blocks_avail : Int63.t;		(** Blocks free (available). *)
  fs_blocks_used : Int63.t;		(** Blocks in use. *)
  fs_inodes_total : Int63.t;		(** Total inodes. *)
  fs_inodes_reserved : Int63.t;		(** Inodes reserved for super-user. *)
  fs_inodes_avail : Int63.t;		(** Inodes free (available). *)
  fs_inodes_used : Int63.t;		(** Inodes in use. *)
}
    (** A filesystem, with superblock contents. *)

and pv = {
  pv_cb : lvm_callbacks;	        (** The LVM plug-in which detected
					    this. *)
  pv_dev : device;			(** Device covering whole PV. *)
  pv_uuid : string;			(** UUID. *)
}
and lv = {
  lv_dev : device;			(** Logical volume device. *)
}
    (** Physical and logical volumes as used by LVM plug-ins. *)

and partitioner_callbacks
and filesystem_callbacks
and lvm_callbacks

(** {2 Functions} *)

val name_of_filesystem : filesystem -> string
  (** [name_of_filesystem fs] returns a printable name for
      the filesystem.
  *)

(** {3 Create 'machine'} *)

val open_machine : string -> (string * string) list -> machine
  (** [open_machine m_name devs]
      creates a {!machine} containing the devices listed.

      [devs] is a list of pairs of [(name, path)] elements
      where [name] is something like ["hda"] and [path]
      is a path to a disk image or [/dev] device.

      This function does not do any scanning, so all disk
      contents are just set to [`Unknown] and there are no
      LV filesystems in the returned structure.
  *)

val open_machine_from_devices : string -> (string * block_device) list ->
  machine
  (** This is the same as {!open_machine} except that instead
      of passing a path you should pass a {!block_device} object. *)

val close_machine : machine -> unit
  (** This is a convenience function which calls the [dev#close]
      method on any open {!block_device}s owned by the machine.  This just
      has the effect of closing any file descriptors which are
      opened by these devices.
  *)

(** {3 Scanning for filesystems} *)

val scan_machine : machine -> machine
  (** This does a complete scan of all devices owned by a machine,
      identifying all partitions, filesystems, physical and logical
      volumes that are known to this library.

      This scans down to the level of the filesystem superblocks.

      Returns an updated {!machine} structure with the scan results.
  *)

(** {3 Create ownership tables} *)

type ownership

val create_ownership : machine -> ownership
  (** This creates the ownership tables (mapping disk blocks to the
      ultimate filesystem, etc., which owns each one).
  *)

type owner =
    [ `Filesystem of filesystem
    | `Partitions of partitions
    | `PhysicalVolume of pv ]

val get_owners_lookup : machine -> ownership -> block_device ->
  (Int63.t -> (owner * Int63.t) list)
  (** [get_owners_lookup machine disk] returns a specialized
      function for looking up owners (filesystems, etc.)
      which reside on block device [disk].

      [disk] must be a block device of the machine.

      The specialized lookup function that is returned
      can be called as [lookup offset] to look up the
      owners of byte offset [offset].

      Returns a list of [(owner, owner_offset)] where [owner]
      is the filesystem, etc., and [owner_offset] is the byte
      offset relative to the owner.

      It is common for there to be multiple owners: for example
      in the case where a filesystem is created on a partition,
      both the filesystem ([`Filesystem fs]) and
      partition scheme ([`Partitions parts]) will be returned.

      The specialized function is efficient.  {!create_ownership}
      creates a tree structure which allows ownership to be determined
      in just a few steps. *)

val offset_is_free : (owner * Int63.t) list -> bool
  (** [offset_is_free owners] tests if the offset is free (unused).

      If an offset is free, then it may be discarded without
      changing the semantics of the disk image.  In normal cases
      this extends to the end of the current block, but blocksize
      will differ for each owner, so what this really means is
      tricky in practice. *)

(** {2 Debugging} *)

val debug : bool ref
  (** If set to true, functions emit debugging information to stderr. *)