1 (* 'df' command for virtual domains.
2 (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
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.
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.
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
31 (* Type of the private data, basically all the metadata that we
32 * read from the NTFS volume.
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 *)
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. *)
47 ntfs_name : string; (* Filename (UTF-8 encoded). *)
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;
56 ntfs_data_size : int63; (* Actual size of data. *)
57 ntfs_runlist : ntfs_runentry list; (* Runlist. *)
60 (* VCN start,size => LCN / None if sparse hole *)
61 (int63 * int63) * int63 option
63 (* Private data functions. *)
64 let attach_private_data, get_private_data =
65 private_data_functions (fun {fs_cb = {fs_cb_uq = u}} -> u)
67 (* Probe for an NTFS filesystem on this device. *)
69 let fs = probe_superblock dev in
72 and probe_superblock dev =
73 (* Load the boot sector / superblock. *)
74 let bits = dev#read_bitstring ~^0 ~^512 in
76 (* Most of this data comes from ntfsprogs' layout.h header file. *)
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. *)
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;
101 clusters_per_index_record : 8;
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. *)
108 let blocksize = bytes_per_sector * sectors_per_cluster in
111 eprintf "%s: NTFS boot sector with blocksize = %d, serial = %Lx\n%!"
112 dev#name blocksize volume_serial_number;
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
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.
122 let fs_dev = new blocksize_overlay blocksize dev in
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
128 let mft = parse_mft dev mft_lcn mft_size in
132 ntfs_blocksize = blocksize;
133 ntfs_mft_lcn = mft_lcn;
134 ntfs_mft_size = mft_size;
135 ntfs_mft_records = mft
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).
142 let blocks_used, blocks_avail = parse_bitmap_freespace ntfs in
144 (* Create a filesystem structure. *)
146 fs_cb = callbacks ();
148 fs_blocksize = blocksize;
149 fs_blocks_total = number_of_sectors *^ bytes_per_sector /^ blocksize;
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;
160 attach_private_data fs ntfs;
163 | { _ } -> raise Not_found (* Not an NTFS boot sector. *)
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
169 (* ... and turn the MFT into records. *)
170 let records = parse_mft_records bits in
173 and parse_mft_records bits =
175 | { "FILE" : 32 : string;
176 (* Assume 3 USAs starting at offset 0x30. XXX? *)
177 0x30 : 16 : littleendian;
178 0x03 : 16 : littleendian;
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. *)
192 (* The attributes. Subtract header size (0x30 bytes)
193 * and space for the USN/USAs (8 bytes).
195 attrs : (Int32.to_int record_size - 0x30 - 8)*8 : bitstring;
197 (* Subsequent MFT records: *)
198 rest : -1 : bitstring } ->
201 eprintf "got an MFT record, now parsing attributes ...\n%!";
204 ntfs_filename = None;
208 let mft_record = parse_attrs attrs mft_record in
210 mft_record :: parse_mft_records rest (* loop rest of MFT records *)
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.
217 | { 0x00000000_l : 32 } -> []
221 and parse_attrs attrs mft_record =
222 (* Parse the MFT record attributes. *)
224 | { 0xFFFFFFFF_l : 32 : littleendian } -> (* AT_END *)
226 eprintf "found AT_END, end of attributes\n%!";
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 } ->
236 let mft_record = parse_resident_attr attr_type attr mft_record in
237 parse_attrs rest mft_record
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 *)
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;
255 (* Table of virtual clusters to logical clusters. *)
256 mapping_pairs : (Int32.to_int attr_size - 0x40) * 8 : bitstring;
258 rest : -1 : bitstring } ->
260 let data_size = Int63.of_int64 data_size in
263 parse_nonresident_attr attr_type highest_vcn
264 allocated_size data_size initialized_size
265 mapping_pairs mft_record in
267 parse_attrs rest mft_record
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.
272 | { attr_type : 32 : littleendian;
273 attr_size : 32 : littleendian;
274 _ : (Int32.to_int attr_size - 8) * 8 : bitstring;
275 rest : -1 : bitstring } ->
278 eprintf "cannot parse MFT attribute entry, attr_type = %lx\n%!"
281 parse_attrs rest mft_record
283 (* Otherwise unparsable & unskippable attribute entry. *)
286 eprintf "corrupt MFT attribute entry\n%!";
289 and parse_resident_attr attr_type attr mft_record =
291 | 0x10_l -> (* AT_STANDARD_INFORMATION *)
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 *) } ->
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
305 { mft_record with ntfs_info = Some info }
309 eprintf "cannot parse AT_STANDARD_INFORMATION\n%!";
313 | 0x30_l -> (* AT_FILE_NAME *)
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 *)
326 name : name_len*16 : string } ->
328 let name = ucs2_to_utf8 name name_len in
332 { mft_record with ntfs_filename = Some filename }
336 eprintf "cannot parse AT_FILE_NAME\n%!";
340 | _ -> (* unknown attribute - just ignore *)
342 eprintf "unknown resident attribute %lx\n%!" attr_type;
345 and parse_nonresident_attr attr_type highest_vcn
346 allocated_size data_size initialized_size
347 mapping_pairs mft_record =
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
353 eprintf "AT_DATA: runlist is:\n";
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))
367 ntfs_data_size = data_size;
368 ntfs_runlist = runlist
370 { mft_record with ntfs_data = Some data }
374 eprintf "unknown non-resident attribute %lx\n%!" attr_type;
377 (* mapping_pairs is not straightforward and not documented well. See
378 * ntfsprogs libntfs/runlist.c:ntfs_mapping_pairs_decompress
380 and parse_runlist vcn lcn bits =
382 | { 0 : 8 } -> (* end of table *)
387 deltavcn : vcnlen * 8 : littleendian;
388 rest : -1 : bitstring
389 } when vcnlen >= 1 && vcnlen <= 4 ->
391 let deltavcn = Int63.of_int64 deltavcn in
393 (* This is a sparse file hole. *)
394 ((vcn, deltavcn), None) ::
395 parse_runlist (vcn +^ deltavcn) lcn rest
397 | { (* Really these fields are signed, but we'll just limit it to
398 * sensible values in the when clause instead.
402 deltavcn : vcnlen * 8 : littleendian;
403 deltalcn : lcnlen * 8 : littleendian;
404 rest : -1 : bitstring
405 } when (vcnlen >= 1 && vcnlen <= 4) && (lcnlen >= 1 || lcnlen <= 4) ->
407 let deltavcn = Int63.of_int64 deltavcn in
408 let deltalcn = Int63.of_int64 deltalcn in (* XXX signed *)
410 let lcn = lcn +^ deltalcn in
412 ((vcn, deltavcn), Some lcn) ::
413 parse_runlist (vcn +^ deltavcn) lcn rest
417 eprintf "unknown field in the runlist\n%!";
418 Bitmatch.hexdump_bitstring Pervasives.stderr bits
422 (* Poor man's little-endian UCS-2 to UTF-8 conversion.
423 * XXX Should use Camomile.
425 and ucs2_to_utf8 name len =
426 (* Calculate length of final string. *)
427 let outlen = ref 0 in
429 for i = 0 to len-1 do
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
438 let outstr = String.create !outlen in
440 for i = 0 to len-1 do
443 let c0 = Char.code name.[j'] and c1 = Char.code name.[j'+1] in
444 let c = c0 + c1 * 256 in
446 outstr.[!outlen] <- Char.chr c;
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
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
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.
466 let file = find_system_file ntfs "$Bitmap" in
468 (* Count used/free bits. *)
469 let used = ref ~^0 and free = ref ~^0 in
470 iter_blocks ntfs file (
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 *)
476 else if c = 0xff then
478 else ( (* uncommon case: count the bits *)
481 if c land !m <> 0 then
484 free := !free +^ ~^1;
492 and find_system_file { ntfs_mft_records = mft_records } fname =
495 | [] -> raise Not_found
496 | ({ ntfs_filename = Some { ntfs_name = name } } as file) :: _
499 | _ :: rest -> loop rest
503 and iter_blocks { ntfs_blocksize = blocksize; ntfs_dev = dev }
504 { ntfs_data = data } f =
506 | None -> () (* No $Data attribute. *)
507 | Some { ntfs_data_size = data_size; ntfs_runlist = runlist } ->
508 let rec loop data_size = function
511 (* Run of vcnsize clusters. *)
512 | ((vcnstart, vcnsize), Some lcn) :: rest ->
513 let data_size = ref data_size 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;
523 vcnsize := !vcnsize -^ ~^1;
524 data_size := !data_size -^ size
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
538 vcnsize := !vcnsize -^ ~^1;
539 data_size := !data_size -^ size
543 loop data_size runlist
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.
549 and read_file { ntfs_blocksize = blocksize; ntfs_dev = dev }
550 { ntfs_data = data } offset size =
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";
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
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 ->
569 | _ :: rest -> find rest
571 let lcn = find runlist in
576 | Some lcn -> dev#read (lcn *^ blocksize +^ vcnoffset) size
577 | None -> String.make (Int63.to_int size) '\000' (* sparse hole *) in
580 (* This is easy: just look at the bitmap. *)
581 and offset_is_free fs offset =
583 let ntfs = get_private_data fs in
584 let blocksize = ntfs.ntfs_blocksize in
586 (* Get the $Bitmap file. *)
587 let file = find_system_file ntfs "$Bitmap" in
589 let lcn = offset /^ blocksize in
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
599 Not_found -> false (* play it safe *)
604 fs_cb_uq = (incr i; !i);
606 fs_cb_printable_name = "Windows NTFS";
607 fs_cb_offset_is_free = offset_is_free;
610 (* Register the plugin. *)
611 let () = register_plugin ~filesystem:probe id