Fix Makefiles to use new bitmatch META file.

[virt-df.git] / lib / diskimage_ntfs.ml

diff --git a/lib/diskimage_ntfs.ml b/lib/diskimage_ntfs.ml
index e4e9036..0c4974c 100644 (file)
--- a/lib/diskimage_ntfs.ml
+++ b/lib/diskimage_ntfs.ml
@@ -101,7 +101,7 @@ and probe_superblock dev =
       _ : 24;
       volume_serial_number : 64 : littleendian;
       checksum : 32 : littleendian;    (* Boot sector checksum. *)
-      code : 8 * 426 : bitstring;      (* Boot code. *)
+      _ : 8 * 426 : bitstring;         (* Boot code. *)
       0x55AA : 16 } ->                 (* End of bootsector magic. *)
 
       let blocksize = bytes_per_sector * sectors_per_cluster in
@@ -112,6 +112,7 @@ and probe_superblock dev =
 
       let blocksize = Int63.of_int blocksize in
       let number_of_sectors = Int63.of_int64 number_of_sectors in
+      let bytes_per_sector = Int63.of_int bytes_per_sector in
 
       (* The blocksize of the filesystem is likely to be quite different
        * from that of the underlying device, so create an overlay device
@@ -227,7 +228,7 @@ and parse_attrs attrs mft_record =
   | { attr_type : 32 : littleendian;
       attr_size : 32 : littleendian;
       0 : 8;                        (* means attribute is resident *)
-      pad : 24*8 - 8 - 64 : bitstring; (* actually meaningful *)
+      _ : 24*8 - 8 - 64 : bitstring; (* actually meaningful *)
       attr : (Int32.to_int attr_size - 24) * 8 : bitstring;
       rest : -1 : bitstring } ->
 
@@ -245,7 +246,7 @@ and parse_attrs attrs mft_record =
       highest_vcn : 64 : littleendian; (* size in clusters - 1 *)
       0x40 : 16 : littleendian;                (* mapping pairs offset *)
       0 : 8;                           (* assume not compressed *)
-      pad : 40 : bitstring;            (* padding *)
+      _ : 40 : bitstring;              (* padding *)
       allocated_size : 64 : littleendian; (* allocate size on disk *)
       data_size : 64 : littleendian;     (* byte size of the attribute *)
       initialized_size : 64 : littleendian;
@@ -269,7 +270,7 @@ and parse_attrs attrs mft_record =
    *)
   | { attr_type : 32 : littleendian;
       attr_size : 32 : littleendian;
-      pad : (Int32.to_int attr_size - 8) * 8 : bitstring;
+      _ : (Int32.to_int attr_size - 8) * 8 : bitstring;
       rest : -1 : bitstring } ->
 
       if !debug then
@@ -530,7 +531,7 @@ and iter_blocks { ntfs_blocksize = blocksize; ntfs_dev = dev }
            let vcnsize = ref vcnsize in
            while !vcnsize > ~^0 && !data_size > ~^0 do
              let size = min blocksize !data_size in
-             let data = String.make size '\000' in
+             let data = String.make (Int63.to_int size) '\000' in
              f None !vcn data;
              vcn := !vcn +^ ~^1;
              vcnsize := !vcnsize -^ ~^1;
@@ -540,7 +541,61 @@ and iter_blocks { ntfs_blocksize = blocksize; ntfs_dev = dev }
       in
       loop data_size runlist
 
-and offset_is_free _ _ = false
+(* This is a bit limited at the moment because it can only read from
+ * a contiguous part of the file.  System files are usually contiguous
+ * so this is OK for us.
+ *)
+and read_file { ntfs_blocksize = blocksize; ntfs_dev = dev }
+    { ntfs_data = data } offset size =
+  match data with
+  | None -> raise Not_found            (* No $Data attribute. *)
+  | Some { ntfs_data_size = data_size; ntfs_runlist = runlist } ->
+      if offset < ~^0 || size < ~^0 || offset +^ size >= data_size then
+       invalid_arg "ntfs: read_file: tried to read outside file";
+
+      (* Get the first and last VCNs containing the data. *)
+      let vcn = offset /^ blocksize in
+      let vcnoffset = offset %^ blocksize in
+      let vcnend = (offset +^ size -^ ~^1) /^ blocksize in
+
+      (* Find the run containing this VCN. *)
+      let rec find = function
+       | [] -> raise Not_found
+       | ((vcnstart, vcnsize), lcn) :: _
+           when vcnstart <= vcn && vcn < vcnstart +^ vcnsize &&
+             vcnstart <= vcnend && vcnend < vcnstart +^ vcnsize ->
+           lcn
+       | _ :: rest -> find rest
+      in
+      let lcn = find runlist in
+
+      (* Read the LCNs. *)
+      let data =
+       match lcn with
+       | Some lcn -> dev#read (lcn *^ blocksize +^ vcnoffset) size
+       | None -> String.make (Int63.to_int size) '\000' (* sparse hole *) in
+      data
+
+(* This is easy: just look at the bitmap. *)
+and offset_is_free fs offset =
+  try
+    let ntfs = get_private_data fs in
+    let blocksize = ntfs.ntfs_blocksize in
+
+    (* Get the $Bitmap file. *)
+    let file = find_system_file ntfs "$Bitmap" in
+
+    let lcn = offset /^ blocksize in
+
+    (* Read the byte in the bitmap corresponding to this LCN. *)
+    let byteoffset = lcn >^> 3 and bitoffset = lcn &^ ~^7 in
+    let byte = read_file ntfs file byteoffset ~^1 in
+    let byte = Char.code byte.[0] in
+    let bit = Int63.of_int byte >^> (0x80 lsr Int63.to_int bitoffset) in
+
+    bit <> ~^0
+  with
+    Not_found -> false                 (* play it safe *)
 
 and callbacks =
   let i = ref 0 in