lib/diskimage_ntfs.ml

   1 (* 'df' command for virtual domains.
   2    (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   3    http://libvirt.org/
   4
   5    This library is free software; you can redistribute it and/or
   6    modify it under the terms of the GNU Lesser General Public
   7    License as published by the Free Software Foundation; either
   8    version 2 of the License, or (at your option) any later version,
   9    with the OCaml linking exception described in ../COPYING.LIB.
  10
  11    This library is distributed in the hope that it will be useful,
  12    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  14    Lesser General Public License for more details.
  15
  16    You should have received a copy of the GNU Lesser General Public
  17    License along with this library; if not, write to the Free Software
  18    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
  19
  20    Support for NTFS.
  21 *)
  22
  23 open Unix
  24 open Printf
  25
  26 open Diskimage_impl
  27 open Int63.Operators
  28
  29 let id = "ntfs"
  30
  31 (* Type of the private data, basically all the metadata that we
  32  * read from the NTFS volume.
  33  *)
  34 type ntfs_fs = {
  35   ntfs_dev : device;                    (* Device. *)
  36   ntfs_blocksize : int63;               (* Blocksize (cluster size) *)
  37   ntfs_mft_lcn : int63;                 (* MFT location (bytes) *)
  38   ntfs_mft_size : int63;                (* MFT size (bytes) *)
  39   ntfs_mft_records : ntfs_mft_record list; (* Files in MFT *)
  40 }
  41 and ntfs_mft_record = {
  42   ntfs_filename : ntfs_filename option; (* Filename, if present. *)
  43   ntfs_info : ntfs_info option;         (* Standard information, if present. *)
  44   ntfs_data : ntfs_data option;         (* $Data stream, if present. *)
  45 }
  46 and ntfs_filename = {
  47   ntfs_name : string;                   (* Filename (UTF-8 encoded). *)
  48 }
  49 and ntfs_info = {
  50   ntfs_creation_time : int64;
  51   ntfs_last_data_change_time : int64;
  52   ntfs_last_mft_change_time : int64;
  53   ntfs_last_access_time : int64;
  54 }
  55 and ntfs_data = {
  56   ntfs_data_size : int63;               (* Actual size of data. *)
  57   ntfs_runlist : ntfs_runentry list;    (* Runlist. *)
  58 }
  59 and ntfs_runentry =
  60     (* VCN start,size => LCN / None if sparse hole *)
  61     (int63 * int63)   *  int63 option
  62
  63 (* Private data functions. *)
  64 let attach_private_data, get_private_data =
  65   private_data_functions (fun {fs_cb = {fs_cb_uq = u}} -> u)
  66
  67 (* Probe for an NTFS filesystem on this device. *)
  68 let rec probe dev =
  69   let fs = probe_superblock dev in
  70   fs
  71
  72 and probe_superblock dev =
  73   (* Load the boot sector / superblock. *)
  74   let bits = dev#read_bitstring ~^0 ~^512 in
  75
  76   (* Most of this data comes from ntfsprogs' layout.h header file. *)
  77   bitmatch bits with
  78   | { _ : 24;                           (* Jump to boot up code. *)
  79       "NTFS    " : 64 : string;         (* NTFS OEM ID (magic). *)
  80       bytes_per_sector : 16 : littleendian;
  81       sectors_per_cluster : 8 : littleendian;
  82       _ : 16;                           (* Reserved sectors - unused. *)
  83       _ : 8;                            (* FATs - unused. *)
  84       _ : 16;                           (* Root entries - unused. *)
  85       _ : 16;                           (* Sectors - unused. *)
  86       _ : 8;                            (* Media type, probably 'f8' = HDD *)
  87       _ : 16;                           (* Sectors per FAT - unused. *)
  88       _ : 16;                           (* Sectors per track. *)
  89       _ : 16;                           (* Heads. *)
  90       _ : 32;                           (* Hidden sectors. *)
  91       _ : 32;                           (* Large sectors. *)
  92       _ : 8;                            (* Physical drive, 0 = FDD, 0x80 = HDD*)
  93       _ : 8;                            (* Current head. *)
  94       _ : 8;                            (* Extended boot signature. *)
  95       _ : 8;                            (* Reserved. *)
  96       number_of_sectors : 64 : littleendian;
  97       mft_lcn : 64 : littleendian;      (* MFT location in clusters. *)
  98       mftmirr_lcn : 64 : littleendian;  (* MFT mirror location. *)
  99       clusters_per_mft_record : 8;
 100       _ : 24;
 101       clusters_per_index_record : 8;
 102       _ : 24;
 103       volume_serial_number : 64 : littleendian;
 104       checksum : 32 : littleendian;     (* Boot sector checksum. *)
 105       _ : 8 * 426 : bitstring;          (* Boot code. *)
 106       0x55AA : 16 } ->                  (* End of bootsector magic. *)
 107
 108       let blocksize = bytes_per_sector * sectors_per_cluster in
 109
 110       if !debug then
 111         eprintf "%s: NTFS boot sector with blocksize = %d, serial = %Lx\n%!"
 112           dev#name blocksize volume_serial_number;
 113
 114       let blocksize = Int63.of_int blocksize in
 115       let number_of_sectors = Int63.of_int64 number_of_sectors in
 116       let bytes_per_sector = Int63.of_int bytes_per_sector in
 117
 118       (* The blocksize of the filesystem is likely to be quite different
 119        * from that of the underlying device, so create an overlay device
 120        * with the natural filesystem blocksize.
 121        *)
 122       let fs_dev = new blocksize_overlay blocksize dev in
 123
 124       (* Get the location and size of the Master File Table. *)
 125       let mft_lcn = Int63.of_int64 mft_lcn *^ blocksize in
 126       let mft_size = Int63.of_int clusters_per_mft_record *^ blocksize in
 127
 128       let mft = parse_mft dev mft_lcn mft_size in
 129
 130       let ntfs = {
 131         ntfs_dev = fs_dev;
 132         ntfs_blocksize = blocksize;
 133         ntfs_mft_lcn = mft_lcn;
 134         ntfs_mft_size = mft_size;
 135         ntfs_mft_records = mft
 136       } in
 137
 138       (* Query free space.  I cannot find any metadata in the NTFS
 139        * structures which records free space directly, so instead we
 140        * need to read the $Bitmap::$Data (bitmap of allocated LCNs).
 141        *)
 142       let blocks_used, blocks_avail = parse_bitmap_freespace ntfs in
 143
 144       (* Create a filesystem structure. *)
 145       let fs = {
 146         fs_cb = callbacks ();
 147         fs_dev = fs_dev;
 148         fs_blocksize = blocksize;
 149         fs_blocks_total = number_of_sectors *^ bytes_per_sector /^ blocksize;
 150         fs_is_swap = false;
 151         fs_blocks_reserved = ~^0;       (* XXX MFT, bitmap are "reserved" *)
 152         fs_blocks_avail = blocks_avail;
 153         fs_blocks_used = blocks_used;
 154         fs_inodes_total = ~^0;          (* XXX MFT records are like inodes *)
 155         fs_inodes_reserved = ~^0;
 156         fs_inodes_avail = ~^0;
 157         fs_inodes_used = ~^0;
 158       } in
 159
 160       attach_private_data fs ntfs;
 161       fs
 162
 163   | { _ } -> raise Not_found            (* Not an NTFS boot sector. *)
 164
 165 and parse_mft dev mft_lcn mft_size =
 166   (* Read the whole of the MFT (which is an array of MFT records) ... *)
 167   let bits = dev#read_bitstring mft_lcn mft_size in
 168
 169   (* ... and turn the MFT into records. *)
 170   let records = parse_mft_records bits in
 171   records
 172
 173 and parse_mft_records bits =
 174   bitmatch bits with
 175   | { "FILE" : 32 : string;
 176       (* Assume 3 USAs starting at offset 0x30. XXX? *)
 177       0x30 : 16 : littleendian;
 178       0x03 : 16 : littleendian;
 179       _ : 64;                           (* lsn *)
 180       _ : 16;                           (* sequence_number *)
 181       _ : 16;                           (* link_count *)
 182       _ : 16;                           (* attrs_offset *)
 183       _ : 16;                           (* MFT_RECORD_FLAGS *)
 184       bytes_in_use : 32 : littleendian;
 185       record_size : 32 : littleendian;
 186       _ : 64;                           (* base_mft_record *)
 187       _ : 16;                           (* next_attr_instance *)
 188       _ : 16;                           (* reserved *)
 189       _ : 32;                           (* mft_record_number *)
 190       _ : 64;                           (* USN, 3 * USAs -- see above. *)
 191
 192       (* The attributes.  Subtract header size (0x30 bytes)
 193        * and space for the USN/USAs (8 bytes).
 194        *)
 195       attrs : (Int32.to_int record_size - 0x30 - 8)*8 : bitstring;
 196
 197       (* Subsequent MFT records: *)
 198       rest : -1 : bitstring } ->
 199
 200       if !debug then
 201         eprintf "got an MFT record, now parsing attributes ...\n%!";
 202
 203       let mft_record = {
 204         ntfs_filename = None;
 205         ntfs_info = None;
 206         ntfs_data = None
 207       } in
 208       let mft_record = parse_attrs attrs mft_record in
 209
 210       mft_record :: parse_mft_records rest (* loop rest of MFT records *)
 211
 212   (* Just assume that the end of the list of MFT records
 213    * is marked by all zeroes.  This seems to be the
 214    * case, but not sure if it is generally true.
 215    * XXX?
 216    *)
 217   | { 0x00000000_l : 32 } -> []
 218
 219   | { _ } -> []
 220
 221 and parse_attrs attrs mft_record =
 222   (* Parse the MFT record attributes. *)
 223   bitmatch attrs with
 224   | { 0xFFFFFFFF_l : 32 : littleendian } -> (* AT_END *)
 225       if !debug then
 226         eprintf "found AT_END, end of attributes\n%!";
 227       mft_record
 228
 229   | { attr_type : 32 : littleendian;
 230       attr_size : 32 : littleendian;
 231       0 : 8;                         (* means attribute is resident *)
 232       _ : 24*8 - 8 - 64 : bitstring; (* actually meaningful *)
 233       attr : (Int32.to_int attr_size - 24) * 8 : bitstring;
 234       rest : -1 : bitstring } ->
 235
 236       let mft_record = parse_resident_attr attr_type attr mft_record in
 237       parse_attrs rest mft_record
 238
 239   | { attr_type : 32 : littleendian;
 240       attr_size : 32 : littleendian;
 241       1 : 8;                            (* non-resident attribute *)
 242       0 : 8;                            (* name length, assume unnamed *)
 243       _ : 16;                           (* name offset *)
 244       _ : 16;                           (* flags *)
 245       _ : 16;                           (* instance number *)
 246       0L : 64 : littleendian;           (* lowest VCN, assume single extent *)
 247       highest_vcn : 64 : littleendian;  (* size in clusters - 1 *)
 248       0x40 : 16 : littleendian;         (* mapping pairs offset *)
 249       0 : 8;                            (* assume not compressed *)
 250       _ : 40 : bitstring;               (* padding *)
 251       allocated_size : 64 : littleendian; (* allocate size on disk *)
 252       data_size : 64 : littleendian;      (* byte size of the attribute *)
 253       initialized_size : 64 : littleendian;
 254
 255       (* Table of virtual clusters to logical clusters. *)
 256       mapping_pairs : (Int32.to_int attr_size - 0x40) * 8 : bitstring;
 257
 258       rest : -1 : bitstring } ->
 259
 260       let data_size = Int63.of_int64 data_size in
 261
 262       let mft_record =
 263         parse_nonresident_attr attr_type highest_vcn
 264           allocated_size data_size initialized_size
 265           mapping_pairs mft_record in
 266
 267       parse_attrs rest mft_record
 268
 269   (* Not matched above, so we don't know how to parse this attribute, but
 270    * there is still enough information to skip to the next one.
 271    *)
 272   | { attr_type : 32 : littleendian;
 273       attr_size : 32 : littleendian;
 274       _ : (Int32.to_int attr_size - 8) * 8 : bitstring;
 275       rest : -1 : bitstring } ->
 276
 277       if !debug then
 278         eprintf "cannot parse MFT attribute entry, attr_type = %lx\n%!"
 279           attr_type;
 280
 281       parse_attrs rest mft_record
 282
 283   (* Otherwise unparsable & unskippable attribute entry. *)
 284   | { _ } ->
 285       if !debug then
 286         eprintf "corrupt MFT attribute entry\n%!";
 287       mft_record
 288
 289 and parse_resident_attr attr_type attr mft_record =
 290   match attr_type with
 291   | 0x10_l ->                           (* AT_STANDARD_INFORMATION *)
 292       (bitmatch attr with
 293        | { creation_time : 64;
 294            last_data_change_time : 64;
 295            last_mft_change_time : 64;
 296            last_access_time : 64
 297            (* other stuff follows, just ignore it *) } ->
 298
 299            let info = {
 300              ntfs_creation_time = creation_time;
 301              ntfs_last_data_change_time = last_data_change_time;
 302              ntfs_last_mft_change_time = last_mft_change_time;
 303              ntfs_last_access_time = last_access_time
 304            } in
 305            { mft_record with ntfs_info = Some info }
 306
 307        | { _ } ->
 308            if !debug then
 309              eprintf "cannot parse AT_STANDARD_INFORMATION\n%!";
 310            mft_record
 311       );
 312
 313   | 0x30_l ->                           (* AT_FILE_NAME *)
 314       (bitmatch attr with
 315        | { _ : 64;                      (* parent directory ref *)
 316            _ : 64;                      (* creation time *)
 317            _ : 64;                      (* last change time *)
 318            _ : 64;                      (* last MFT change time *)
 319            _ : 64;                      (* last access time *)
 320            _ : 64;                      (* allocated size *)
 321            _ : 64;                      (* data size *)
 322            _ : 32;
 323            _ : 32;
 324            name_len : 8;
 325            name_type_flags : 8;
 326            name : name_len*16 : string } ->
 327
 328            let name = ucs2_to_utf8 name name_len in
 329            let filename = {
 330              ntfs_name = name
 331            } in
 332            { mft_record with ntfs_filename = Some filename }
 333
 334        | { _ } ->
 335            if !debug then
 336              eprintf "cannot parse AT_FILE_NAME\n%!";
 337            mft_record
 338       );
 339
 340   | _ ->                                (* unknown attribute - just ignore *)
 341       if !debug then
 342         eprintf "unknown resident attribute %lx\n%!" attr_type;
 343       mft_record
 344
 345 and parse_nonresident_attr attr_type highest_vcn
 346     allocated_size data_size initialized_size
 347     mapping_pairs mft_record =
 348   match attr_type with
 349   | 0x80_l ->                           (* AT_DATA, ie. the $Data stream *)
 350       let lowest_vcn = ~^0 (* see assumption above *) in
 351       let runlist = parse_runlist lowest_vcn ~^0 mapping_pairs in
 352       if !debug then (
 353         eprintf "AT_DATA: runlist is:\n";
 354         List.iter (
 355           function
 356           | ((vcn, deltavcn), Some lcn) ->
 357             eprintf "\tVCNs %s..%s -> LCN %s\n"
 358               (Int63.to_string vcn) (Int63.to_string (vcn +^ deltavcn -^ ~^1))
 359               (Int63.to_string lcn)
 360           | ((vcn, deltavcn), None) ->
 361             eprintf "\tVCNs %s..%s -> sparse hole\n"
 362               (Int63.to_string vcn) (Int63.to_string (vcn +^ deltavcn -^ ~^1))
 363         ) runlist
 364       );
 365
 366       let data = {
 367         ntfs_data_size = data_size;
 368         ntfs_runlist = runlist
 369       } in
 370       { mft_record with ntfs_data = Some data }
 371
 372   | _ ->
 373       if !debug then
 374         eprintf "unknown non-resident attribute %lx\n%!" attr_type;
 375       mft_record
 376
 377 (* mapping_pairs is not straightforward and not documented well.  See
 378  * ntfsprogs libntfs/runlist.c:ntfs_mapping_pairs_decompress
 379  *)
 380 and parse_runlist vcn lcn bits =
 381   bitmatch bits with
 382   | { 0 : 8 } ->                        (* end of table *)
 383       []
 384
 385   | { 0 : 4;
 386       vcnlen : 4;
 387       deltavcn : vcnlen * 8 : littleendian;
 388       rest : -1 : bitstring
 389     } when vcnlen >= 1 && vcnlen <= 4 ->
 390
 391       let deltavcn = Int63.of_int64 deltavcn in
 392
 393       (* This is a sparse file hole. *)
 394       ((vcn, deltavcn), None) ::
 395         parse_runlist (vcn +^ deltavcn) lcn rest
 396
 397   | { (* Really these fields are signed, but we'll just limit it to
 398        * sensible values in the when clause instead.
 399        *)
 400       lcnlen : 4;
 401       vcnlen : 4;
 402       deltavcn : vcnlen * 8 : littleendian;
 403       deltalcn : lcnlen * 8 : littleendian;
 404       rest : -1 : bitstring
 405     } when (vcnlen >= 1 && vcnlen <= 4) && (lcnlen >= 1 || lcnlen <= 4) ->
 406
 407       let deltavcn = Int63.of_int64 deltavcn in
 408       let deltalcn = Int63.of_int64 deltalcn in (* XXX signed *)
 409
 410       let lcn = lcn +^ deltalcn in
 411
 412       ((vcn, deltavcn), Some lcn) ::
 413         parse_runlist (vcn +^ deltavcn) lcn rest
 414
 415   | { _ } ->
 416       if !debug then (
 417         eprintf "unknown field in the runlist\n%!";
 418         Bitmatch.hexdump_bitstring Pervasives.stderr bits
 419       );
 420       []
 421
 422 (* Poor man's little-endian UCS-2 to UTF-8 conversion.
 423  * XXX Should use Camomile.
 424  *)
 425 and ucs2_to_utf8 name len =
 426   (* Calculate length of final string. *)
 427   let outlen = ref 0 in
 428   let j = ref 0 in
 429   for i = 0 to len-1 do
 430     let j' = !j in
 431     j := j' + 2;
 432     let c0 = Char.code name.[j'] and c1 = Char.code name.[j'+1] in
 433     let c = c0 + c1 * 256 in
 434     if c < 128 then incr outlen
 435     else if c < 0x800 then outlen := !outlen + 2
 436     else outlen := !outlen + 3
 437   done;
 438   let outstr = String.create !outlen in
 439   j := 0; outlen := 0;
 440   for i = 0 to len-1 do
 441     let j' = !j in
 442     j := j' + 2;
 443     let c0 = Char.code name.[j'] and c1 = Char.code name.[j'+1] in
 444     let c = c0 + c1 * 256 in
 445     if c < 128 then (
 446       outstr.[!outlen] <- Char.chr c;
 447       incr outlen
 448     ) else if c < 0x800 then (
 449       outstr.[!outlen] <- Char.chr (0b11000000 lor (c lsr 6));
 450       outstr.[!outlen+1] <- Char.chr (0b10000000 lor (c land 0b00111111));
 451       outlen := !outlen + 2
 452     ) else (
 453       outstr.[!outlen] <- Char.chr (0b11100000 lor (c lsr 12));
 454       outstr.[!outlen+1] <- Char.chr (0b10000000 lor ((c lsr 6) lor 0b00111111));
 455       outstr.[!outlen+2] <- Char.chr (0b10000000 lor (c land 0b00111111));
 456       outlen := !outlen + 3
 457     )
 458   done;
 459   outstr
 460
 461 (* Parse $Bitmap::$Data to get free/used.  Returns (used, free) blocks. *)
 462 and parse_bitmap_freespace ntfs =
 463   (* Can throw Not_found - allow that to escape because we don't
 464    * expect an NTFS filesystem without this magic file.
 465    *)
 466   let file = find_system_file ntfs "$Bitmap" in
 467
 468   (* Count used/free bits. *)
 469   let used = ref ~^0 and free = ref ~^0 in
 470   iter_blocks ntfs file (
 471     fun lcn vcn data ->
 472       for i = 0 to String.length data - 1 do
 473         let c = Char.code data.[i] in
 474         if c = 0 then                   (* common cases *)
 475           free := !free +^ ~^8
 476         else if c = 0xff then
 477           used := !used +^ ~^8
 478         else (                          (* uncommon case: count the bits *)
 479           let m = ref 0x80 in
 480           while !m > 0 do
 481             if c land !m <> 0 then
 482               used := !used +^ ~^1
 483             else
 484               free := !free +^ ~^1;
 485             m := !m lsr 1
 486           done
 487         )
 488       done
 489   );
 490   (!used, !free)
 491
 492 and find_system_file { ntfs_mft_records = mft_records } fname =
 493   let rec loop =
 494     function
 495     | [] -> raise Not_found
 496     | ({ ntfs_filename = Some { ntfs_name = name } } as file) :: _
 497         when name = fname ->
 498         file
 499     | _ :: rest -> loop rest
 500   in
 501   loop mft_records
 502
 503 and iter_blocks { ntfs_blocksize = blocksize; ntfs_dev = dev }
 504     { ntfs_data = data } f =
 505   match data with
 506   | None -> ()                          (* No $Data attribute. *)
 507   | Some { ntfs_data_size = data_size; ntfs_runlist = runlist } ->
 508       let rec loop data_size = function
 509         | [] -> ()
 510
 511         (* Run of vcnsize clusters. *)
 512         | ((vcnstart, vcnsize), Some lcn) :: rest ->
 513             let data_size = ref data_size in
 514             let lcn = ref lcn in
 515             let vcn = ref vcnstart in
 516             let vcnsize = ref vcnsize in
 517             while !vcnsize > ~^0 && !data_size > ~^0 do
 518               let size = min blocksize !data_size in
 519               let data = dev#read (!lcn *^ blocksize) size in
 520               f (Some !lcn) !vcn data;
 521               lcn := !lcn +^ ~^1;
 522               vcn := !vcn +^ ~^1;
 523               vcnsize := !vcnsize -^ ~^1;
 524               data_size := !data_size -^ size
 525             done;
 526             loop !data_size rest
 527
 528         (* Sparse hole. *)
 529         | ((vcnstart, vcnsize), None) :: rest ->
 530             let data_size = ref data_size in
 531             let vcn = ref vcnstart in
 532             let vcnsize = ref vcnsize in
 533             while !vcnsize > ~^0 && !data_size > ~^0 do
 534               let size = min blocksize !data_size in
 535               let data = String.make (Int63.to_int size) '\000' in
 536               f None !vcn data;
 537               vcn := !vcn +^ ~^1;
 538               vcnsize := !vcnsize -^ ~^1;
 539               data_size := !data_size -^ size
 540             done;
 541             loop !data_size rest
 542       in
 543       loop data_size runlist
 544
 545 (* This is a bit limited at the moment because it can only read from
 546  * a contiguous part of the file.  System files are usually contiguous
 547  * so this is OK for us.
 548  *)
 549 and read_file { ntfs_blocksize = blocksize; ntfs_dev = dev }
 550     { ntfs_data = data } offset size =
 551   match data with
 552   | None -> raise Not_found             (* No $Data attribute. *)
 553   | Some { ntfs_data_size = data_size; ntfs_runlist = runlist } ->
 554       if offset < ~^0 || size < ~^0 || offset +^ size >= data_size then
 555         invalid_arg "ntfs: read_file: tried to read outside file";
 556
 557       (* Get the first and last VCNs containing the data. *)
 558       let vcn = offset /^ blocksize in
 559       let vcnoffset = offset %^ blocksize in
 560       let vcnend = (offset +^ size -^ ~^1) /^ blocksize in
 561
 562       (* Find the run containing this VCN. *)
 563       let rec find = function
 564         | [] -> raise Not_found
 565         | ((vcnstart, vcnsize), lcn) :: _
 566             when vcnstart <= vcn && vcn < vcnstart +^ vcnsize &&
 567               vcnstart <= vcnend && vcnend < vcnstart +^ vcnsize ->
 568             lcn
 569         | _ :: rest -> find rest
 570       in
 571       let lcn = find runlist in
 572
 573       (* Read the LCNs. *)
 574       let data =
 575         match lcn with
 576         | Some lcn -> dev#read (lcn *^ blocksize +^ vcnoffset) size
 577         | None -> String.make (Int63.to_int size) '\000' (* sparse hole *) in
 578       data
 579
 580 (* This is easy: just look at the bitmap. *)
 581 and offset_is_free fs offset =
 582   try
 583     let ntfs = get_private_data fs in
 584     let blocksize = ntfs.ntfs_blocksize in
 585
 586     (* Get the $Bitmap file. *)
 587     let file = find_system_file ntfs "$Bitmap" in
 588
 589     let lcn = offset /^ blocksize in
 590
 591     (* Read the byte in the bitmap corresponding to this LCN. *)
 592     let byteoffset = lcn >^> 3 and bitoffset = lcn &^ ~^7 in
 593     let byte = read_file ntfs file byteoffset ~^1 in
 594     let byte = Char.code byte.[0] in
 595     let bit = Int63.of_int byte >^> (0x80 lsr Int63.to_int bitoffset) in
 596
 597     bit <> ~^0
 598   with
 599     Not_found -> false                  (* play it safe *)
 600
 601 and callbacks =
 602   let i = ref 0 in
 603   fun () -> {
 604     fs_cb_uq = (incr i; !i);
 605     fs_cb_name = id;
 606     fs_cb_printable_name = "Windows NTFS";
 607     fs_cb_offset_is_free = offset_is_free;
 608   }
 609
 610 (* Register the plugin. *)
 611 let () = register_plugin ~filesystem:probe id