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