+++ /dev/null
-(* Windows Registry reverse-engineering tool.
- * Copyright (C) 2010 Red Hat Inc.
- *
- * 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.,
- * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
- *
- * For existing information on the registry format, please refer
- * to the following documents. Note they are both incomplete
- * and inaccurate in some respects.
- *
- * http://www.sentinelchicken.com/data/TheWindowsNTRegistryFileFormat.pdf
- * http://pogostick.net/~pnh/ntpasswd/WinReg.txt
- *)
-
-open Bitstring
-open ExtString
-open Printf
-open Visualizer_utils
-open Visualizer_NT_time
-
-let () =
- if Array.length Sys.argv <> 2 then (
- eprintf "Error: missing argument.
-Usage: %s hivefile > out
-where
- 'hivefile' is the input hive file from a Windows machine
- 'out' is an output file where we will write all the keys,
- values etc for extended debugging purposes.
-Errors, inconsistencies and unexpected fields in the hive file
-are written to stderr.
-" Sys.executable_name;
- exit 1
- )
-
-let filename = Sys.argv.(1)
-let basename = Filename.basename filename
-
-(* Load the file. *)
-let bits = bitstring_of_file filename
-
-(* Split into header + data at the 4KB boundary. *)
-let header, data = takebits (4096 * 8) bits, dropbits (4096 * 8) bits
-
-(* Define a persistent pattern which matches the header fields. By
- * using persistent patterns, we can reuse them later in the
- * program.
- *)
-let bitmatch header_fields =
- { "regf" : 4*8 : string;
- seq1 : 4*8 : littleendian;
- seq2 : 4*8 : littleendian;
- last_modified : 64
- : littleendian, bind (nt_to_time_t last_modified);
- major : 4*8 : littleendian;
- minor : 4*8 : littleendian;
-
- (* "Type". Contains 0. *)
- unknown1 : 4*8 : littleendian;
-
- (* "Format". Contains 1. *)
- unknown2 : 4*8 : littleendian;
-
- root_key : 4*8
- : littleendian, bind (get_offset root_key);
- end_pages : 4*8
- : littleendian, bind (get_offset end_pages);
-
- (* "Cluster". Contains 1. *)
- unknown3 : 4*8 : littleendian;
-
- filename : 64*8 : string;
-
- (* All three GUIDs here confirmed in Windows 7 registries. In
- * Windows <= 2003 these GUID fields seem to contain junk.
- *
- * If you write zeroes to the GUID fields, load and unload in Win7
- * REGEDIT, then Windows 7 writes some random GUIDs.
- *
- * Also (on Win7) unknownguid1 == unknownguid2. unknownguid3 is
- * different.
- *)
- unknownguid1 : 16*8 : bitstring;
- unknownguid2 : 16*8 : bitstring;
-
- (* Wrote zero to unknown4, loaded and unloaded it in Win7 REGEDIT,
- * and it still contained zero. In existing registries it seems to
- * contain random junk.
- *)
- unknown4 : 4*8 : littleendian;
- unknownguid3 : 16*8 : bitstring;
-
- (* If you write zero to unknown5, load and unload it in REGEDIT,
- * Windows 7 puts the string "rmtm" here. Existing registries also
- * seen containing this string. However on older Windows it can
- * be all zeroes.
- *)
- unknown5 : 4*8 : string;
-
- (* This seems to contain junk from other parts of the registry. I
- * wrote zeroes here, loaded and unloaded it in Win7 REGEDIT, and
- * it still contained zeroes.
- *)
- unknown6 : 340*8 : bitstring;
- csum : 4*8
- : littleendian, save_offset_to (crc_offset),
- check (assert (crc_offset = 0x1fc * 8); true);
- unknown7 : (0x1000-0x200)*8 : bitstring }
-
-let fprintf_header chan bits =
- bitmatch bits with
- | { :header_fields } ->
- fprintf chan
- "HD %6ld %6ld %s %ld.%ld %08lx %08lx %s %s %08lx %s %s %s %08lx %s %s %s %08lx %s\n"
- seq1 seq2 (print_time last_modified) major minor
- unknown1 unknown2
- (print_offset root_key) (print_offset end_pages)
- unknown3 (print_utf16 filename)
- (print_guid unknownguid1) (print_guid unknownguid2)
- unknown4 (print_guid unknownguid3) unknown5
- (print_bitstring unknown6)
- csum (print_bitstring unknown7)
-
-(* Parse the header and check it. *)
-let root_key, end_pages =
- bitmatch header with
- | { :header_fields } ->
- fprintf_header stdout header;
-
- if major <> 1_l then
- eprintf "HD hive file major <> 1 (major.minor = %ld.%ld)\n"
- major minor;
- if seq1 <> seq2 then
- eprintf "HD hive file sequence numbers should match (%ld <> %ld)\n"
- seq1 seq2;
- if unknown1 <> 0_l then
- eprintf "HD unknown1 field <> 0 (%08lx)\n" unknown1;
- if unknown2 <> 1_l then
- eprintf "HD unknown2 field <> 1 (%08lx)\n" unknown2;
- if unknown3 <> 1_l then
- eprintf "HD unknown3 field <> 1 (%08lx)\n" unknown3;
- if not (equals unknownguid1 unknownguid2) then
- eprintf "HD unknownguid1 <> unknownguid2 (%s, %s)\n"
- (print_guid unknownguid1) (print_guid unknownguid2);
- (* We think this is junk.
- if unknown4 <> 0_l then
- eprintf "HD unknown4 field <> 0 (%08lx)\n" unknown4;
- *)
- if unknown5 <> "rmtm" && unknown5 <> "\000\000\000\000" then
- eprintf "HD unknown5 field <> \"rmtm\" & <> zeroes (%s)\n" unknown5;
- (* We think this is junk.
- if not (is_zero_bitstring unknown6) then
- eprintf "HD unknown6 area is not zero (%s)\n"
- (print_bitstring unknown6);
- *)
- if not (is_zero_bitstring unknown7) then
- eprintf "HD unknown7 area is not zero (%s)\n"
- (print_bitstring unknown7);
-
- root_key, end_pages
- | {_} ->
- failwithf "%s: this doesn't look like a registry hive file\n" basename
-
-(* Define persistent patterns to match page and block fields. *)
-let bitmatch page_fields =
- { "hbin" : 4*8 : string;
- page_offset : 4*8
- : littleendian, bind (get_offset page_offset);
- page_size : 4*8
- : littleendian, check (Int32.rem page_size 4096_l = 0_l),
- bind (Int32.to_int page_size);
-
- (* In the first hbin in the file these fields contain something.
- * In subsequent hbins these fields are all zero.
- *
- * From existing hives (first hbin only):
- *
- * unknown1 unknown2 unknown5
- * 00 00 00 00 00 00 00 00 9C 77 3B 02 6A 7D CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 50 3A 15 07 B5 9B CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 57 86 90 D4 9A 58 CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 52 3F 90 9D CF 7C CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 E8 86 C1 17 BD 06 CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 4A 77 CE 7A CF 7C CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 E4 EA 23 FF 69 7D CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 50 13 BA 8D A2 9A CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 0E 07 93 13 BD 06 CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 9D 55 D0 B3 99 58 CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 46 AC FF 8B CF 7C CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 80 29 2D 02 6A 7D CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 90 8D 36 07 B5 9B CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 5C 9B 8B B8 6A 06 CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 85 9F BB 99 9A 58 CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 BE 3D 21 02 6A 7D CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 70 53 09 07 B5 9B CA 01 00 00 00 00
- * 00 00 00 00 00 00 00 00 5B 62 42 B6 9A 58 CA 01 00 00 00 00
- * 01 00 00 00 00 00 00 00 B2 46 9B 9E CF 7C CA 01 00 00 00 00
- * 01 00 00 00 00 00 00 00 CA 88 EE 1A BD 06 CA 01 00 00 00 00
- *
- * From the above we worked out that fields 3 and 4 are an NT
- * timestamp, which seems to be "last modified" (when REGEDIT
- * unloads a hive it updates this timestamp even if nothing
- * has been changed).
- *)
- unknown1 : 4*8 : littleendian; (* usually zero, occasionally 1 *)
- unknown2 : 4*8 : littleendian; (* always zero? *)
- last_modified : 64
- : littleendian,
- bind (if page_offset = 0 then nt_to_time_t last_modified
- else (
- assert (last_modified = 0_L);
- 0.
- )
- );
- (* The "B.D." document said this field contains the page size, but
- * this is not true. This misinformation has been copied to the
- * sentinelchicken documentation too.
- *)
- unknown5 : 4*8 : littleendian; (* always zero? *)
-
- (* Now the blocks in this page follow. *)
- blocks : (page_size - 32) * 8 : bitstring;
-
- rest : -1 : bitstring }
-
-let fprintf_page chan bits =
- bitmatch bits with
- | { :page_fields } ->
- fprintf chan "HB %s %08x %08lx %08lx %s %08lx\n"
- (print_offset page_offset)
- page_size unknown1 unknown2
- (if page_offset = 0 then print_time last_modified
- else string_of_float last_modified) unknown5
-
-let bitmatch block_fields =
- { seg_len : 4*8
- : littleendian, bind (Int32.to_int seg_len);
- block_data : (abs seg_len - 4) * 8 : bitstring;
- rest : -1 : bitstring }
-
-let fprintf_block chan block_offset bits =
- bitmatch bits with
- | { :block_fields } ->
- fprintf chan "BL %s %s %d\n"
- (print_offset block_offset)
- (if seg_len < 0 then "used" else "free")
- (if seg_len < 0 then -seg_len else seg_len)
-
-(* Iterate over the pages and blocks. In the process we will examine
- * each page (hbin) header. Also we will build block_list which is a
- * list of (block offset, length, used flag, data).
- *)
-let block_list = ref []
-let () =
- let rec loop_over_pages data data_offset =
- if data_offset < end_pages then (
- bitmatch data with
- | { rest : -1 : bitstring } when bitstring_length rest = 0 -> ()
-
- | { :page_fields } ->
- fprintf_page stdout data;
-
- assert (page_offset = data_offset);
-
- if data_offset = 0 then ( (* first hbin only *)
- if unknown1 <> 0_l then
- eprintf "HB %s unknown1 field <> 0 (%08lx)\n"
- (print_offset page_offset) unknown1;
- if unknown2 <> 0_l then
- eprintf "HB %s unknown2 field <> 0 (%08lx)\n"
- (print_offset page_offset) unknown2;
- if unknown5 <> 0_l then
- eprintf "HB %s unknown5 field <> 0 (%08lx)\n"
- (print_offset page_offset) unknown5
- ) else ( (* subsequent hbins *)
- if unknown1 <> 0_l || unknown2 <> 0_l || unknown5 <> 0_l then
- eprintf "HB %s unknown fields <> 0 (%08lx %08lx %08lx)\n"
- (print_offset page_offset)
- unknown1 unknown2 unknown5;
- if last_modified <> 0. then
- eprintf "HB %s last_modified <> 0. (%g)\n"
- (print_offset page_offset) last_modified
- );
-
- (* Loop over the blocks in this page. *)
- loop_over_blocks blocks (data_offset + 32);
-
- (* Loop over rest of the pages. *)
- loop_over_pages rest (data_offset + page_size)
-
- | {_} ->
- failwithf "%s: invalid hbin at offset %s\n"
- basename (print_offset data_offset)
- ) else (
- (* Reached the end of the official hbins in this file, BUT the
- * file can be larger than this and might contain stuff. What
- * does it contain after the hbins? We think just junk, but
- * we're not sure.
- *)
- if not (is_zero_bitstring data) then (
- eprintf "Junk in file after end of pages:\n";
- let rec loop data data_offset =
- bitmatch data with
- | { rest : -1 : bitstring } when bitstring_length rest = 0 -> ()
- | { :page_fields } ->
- eprintf "\tjunk hbin %s 0x%08x\n"
- (print_offset data_offset) page_size;
- loop rest (data_offset + page_size);
- | { _ } ->
- eprintf "\tother junk %s %s\n"
- (print_offset data_offset) (print_bitstring data)
- in
- loop data data_offset
- )
- )
- and loop_over_blocks blocks block_offset =
- bitmatch blocks with
- | { rest : -1 : bitstring } when bitstring_length rest = 0 -> ()
-
- | { :block_fields } ->
- assert (block_offset mod 8 = 0);
-
- fprintf_block stdout block_offset blocks;
-
- let used, seg_len =
- if seg_len < 0 then true, -seg_len else false, seg_len in
-
- let block = block_offset, (seg_len, used, block_data) in
- block_list := block :: !block_list;
-
- (* Loop over the rest of the blocks in this page. *)
- loop_over_blocks rest (block_offset + seg_len)
-
- | {_} ->
- failwithf "%s: invalid block near offset %s\n"
- basename (print_offset block_offset)
- in
- loop_over_pages data 0
-
-(* Turn the block_list into a map so we can quickly look up a block
- * from its offset.
- *)
-let block_list = !block_list
-let block_map =
- List.fold_left (
- fun map (block_offset, block) -> IntMap.add block_offset block map
- ) IntMap.empty block_list
-let lookup fn offset =
- try
- let (_, used, _) as block = IntMap.find offset block_map in
- if not used then
- failwithf "%s: %s: lookup: free block %s referenced from hive tree"
- basename fn (print_offset offset);
- block
- with Not_found ->
- failwithf "%s: %s: lookup: unknown block %s referenced from hive tree"
- basename fn (print_offset offset)
-
-(* Use this to mark blocks that we've visited. If the hive contains
- * no unreferenced blocks, then by the end this should just contain
- * free blocks.
- *)
-let mark_visited, is_not_visited, unvisited_blocks =
- let v = ref block_map in
- let mark_visited offset = v := IntMap.remove offset !v
- and is_not_visited offset = IntMap.mem offset !v
- and unvisited_blocks () = !v in
- mark_visited, is_not_visited, unvisited_blocks
-
-(* Define persistent patterns to match nk-records, vk-records and
- * sk-records, which are the record types that we especially want to
- * analyze later. Other blocks types (eg. value lists, lf-records)
- * have no "spare space" so everything is known about them and we don't
- * store these.
- *)
-let bitmatch nk_fields =
- { "nk" : 2*8 : string;
- (* Flags stored in the file as a little endian word, hence the
- * unusual ordering:
- *)
- virtmirrored : 1;
- predefinedhandle : 1; keynameascii : 1; symlinkkey : 1;
- cannotbedeleted : 1; isroot : 1; ismountpoint : 1; isvolatile : 1;
- unknownflag8000 : 1; unknownflag4000 : 1;
- unknownflag2000 : 1; unknownflag1000 : 1;
- unknownflag0800 : 1; unknownflag0400 : 1;
- virtualstore : 1; virttarget : 1;
- timestamp : 64 : littleendian, bind (nt_to_time_t timestamp);
- unknown1 : 4*8 : littleendian;
- parent : 4*8 : littleendian, bind (get_offset parent);
- nr_subkeys : 4*8 : littleendian, bind (Int32.to_int nr_subkeys);
- nr_subkeys_vol : 4*8;
- subkeys : 4*8 : littleendian, bind (get_offset subkeys);
- subkeys_vol : 4*8;
- nr_values : 4*8 : littleendian, bind (Int32.to_int nr_values);
- vallist : 4*8 : littleendian, bind (get_offset vallist);
- sk : 4*8 : littleendian, bind (get_offset sk);
- classname : 4*8 : littleendian, bind (get_offset classname);
- (* sentinelchicken.com says this is a single 32 bit field
- * containing maximum number of bytes in a subkey name, however
- * that does not seem to be correct. We think it is several
- * fields, the first being the maximum number of bytes in the
- * UTF16-LE encoded version of the subkey names, (since subkey
- * names are usually ASCII, that would be max length of names * 2).
- * This is a historical maximum, so it can be greater than the
- * current maximum name field.
- *
- * The remaining fields are often non-zero, but the purpose is
- * unknown.
- *
- * In the hives we examined the other fields had values as
- * follows:
- * userflags: 0, 2, 0xa, 0xe
- * virtcontrolflags: 0, 1
- * debug: always 0
- *)
- max_subkey_name_len : 2*8 : littleendian;
- unknown2_userflags : 4;
- unknown2_virtcontrolflags : 4;
- unknown2_debug : 8;
-
- (* sentinelchicken.com says: maximum subkey CLASSNAME length,
- * however that does not seem to be correct. In hives I looked
- * at, it has value 0, 0xc, 0x10, 0x18, 0x1a, 0x28.
- *)
- unknown3 : 4*8 : littleendian;
- (* sentinelchicken.com says: maximum number of bytes in a value
- * name, however that does not seem to be correct. We think it is
- * the maximum number of bytes in the UTF16-LE encoded version of
- * the value names (since value names are usually ASCII, that would
- * be max length of names * 2). This is a historical maximum, so
- * it can be greater than the current maximum name field.
- *)
- max_vk_name_len : 4*8 : littleendian, bind (Int32.to_int max_vk_name_len);
- (* sentinelchicken.com says: maximum value data size, and this
- * agrees with my observations. It is the largest data size (not
- * seg_len, but vk.data_len) for any value in this key. We think
- * that this field is a historical max, so eg if a maximally sized
- * value is deleted then this field is not reduced. Certainly
- * max_vk_data_len >= the measured maximum in all the hives that we
- * have observed.
- *)
- max_vk_data_len : 4*8 : littleendian, bind (Int32.to_int max_vk_data_len);
- unknown6 : 4*8 : littleendian;
- name_len : 2*8 : littleendian;
- classname_len : 2*8 : littleendian;
- name : name_len * 8 : string }
-
-let fprintf_nk chan nk =
- let (_, _, bits) = lookup "fprintf_nk" nk in
- bitmatch bits with
- | { :nk_fields } ->
- fprintf chan
- "NK %s %s%s%s%s%s%s%s%s%s%s%s%s%s%s%s%s %s %08lx %s %d %ld %s %08lx %d %s %s %s %d %x %x %x %08lx %d %d %08lx %d %d %s\n"
- (print_offset nk)
- (if unknownflag8000 then "8" else ".")
- (if unknownflag4000 then "4" else ".")
- (if unknownflag2000 then "2" else ".")
- (if unknownflag1000 then "1" else ".")
- (if unknownflag0800 then "8" else ".")
- (if unknownflag0400 then "4" else ".")
- (if virtualstore then "s" else ".")
- (if virttarget then "t" else ".")
- (if virtmirrored then "m" else ".")
- (if predefinedhandle then "P" else ".")
- (if keynameascii then "A" else ".")
- (if symlinkkey then "S" else ".")
- (if cannotbedeleted then "N" else ".")
- (if isroot then "R" else ".")
- (if ismountpoint then "M" else ".")
- (if isvolatile then "V" else ".")
- (print_time timestamp)
- unknown1 (print_offset parent) nr_subkeys nr_subkeys_vol
- (print_offset subkeys) subkeys_vol
- nr_values (print_offset vallist)
- (print_offset sk) (print_offset classname)
- max_subkey_name_len
- unknown2_userflags unknown2_virtcontrolflags unknown2_debug
- unknown3 max_vk_name_len max_vk_data_len unknown6
- name_len classname_len name
-
-type data_t = Inline of bitstring | Offset of int
-let bitmatch vk_fields =
- { "vk" : 2*8 : string;
- name_len : 2*8 : littleendian;
- (* Top bit set means that the data is stored inline. In that case
- * the data length must be <= 4. The length can also be 0 (or
- * 0x80000000) if the data type is NONE.
- *)
- data_len : 4*8
- : littleendian, bind (
- let is_inline = Int32.logand data_len 0x8000_0000_l = 0x8000_0000_l in
- let data_len = Int32.to_int (Int32.logand data_len 0x7fff_ffff_l) in
- if is_inline then assert (data_len <= 4) else assert (data_len > 4);
- is_inline, data_len
- );
- (* The data itself depends on the type field.
- *
- * For REG_SZ type, the data always seems to be NUL-terminated, which
- * means because these strings are often UTF-16LE, that the string will
- * end with \0\0 bytes. The termination bytes are included in data_len.
- *
- * For REG_MULTI_SZ, see
- * http://blogs.msdn.com/oldnewthing/archive/2009/10/08/9904646.aspx
- *)
- data : 4*8
- : bitstring, bind (
- let is_inline, data_len = data_len in
- if is_inline then
- Inline (takebits (data_len*8) data)
- else (
- let offset =
- bitmatch data with { offset : 4*8 : littleendian } -> offset in
- let offset = get_offset offset in
- Offset offset
- )
- );
- t : 4*8 : littleendian, bind (Int32.to_int t);
- (* Flags, stored as a little-endian word: *)
- unknown1 : 7;
- nameisascii : 1; (* Clear for default [zero-length] name, always set
- * otherwise in registries that we found. Perhaps this
- * is really "nameisdefault" flag?
- *)
- unknown2 : 8;
- (* Unknown field, usually contains something. *)
- unknown3 : 2*8 : littleendian;
- name : name_len * 8 : string }
-
-let fprintf_vk chan vk =
- let (_, _, bits) = lookup "fprintf_vk" vk in
- bitmatch bits with
- | { :vk_fields } ->
- let real_data =
- match data with
- | Inline data -> data
- | Offset offset ->
- let (_, _, bits) = lookup "fprintf_vk (data)" offset in
- bits in
- let is_inline, data_len = data_len in
- fprintf chan "VK %s %s %s %d %s%s %s %08x %s %08x %08x\n"
- (print_offset vk)
- name (if is_inline then "inline" else "-") data_len
- (match data with
- | Inline _ -> ""
- | Offset offset -> "["^print_offset offset^"]")
- (print_bitstring real_data)
- (print_vk_type t)
- unknown1 (if nameisascii then "A" else "L")
- unknown2 unknown3
-
-let bitmatch sk_fields =
- { "sk" : 2*8 : string;
- unknown1 : 2*8 : littleendian;
- sk_next : 4*8 : littleendian, bind (get_offset sk_next);
- sk_prev : 4*8 : littleendian, bind (get_offset sk_prev);
- refcount : 4*8 : littleendian, bind (Int32.to_int refcount);
- sec_len : 4*8 : littleendian, bind (Int32.to_int sec_len);
- sec_desc : sec_len * 8 : bitstring }
-
-let fprintf_sk chan sk =
- let (_, _, bits) = lookup "fprintf_sk" sk in
- bitmatch bits with
- | { :sk_fields } ->
- fprintf chan "SK %s %04x %s %s %d %d\n"
- (print_offset sk) unknown1
- (print_offset sk_next) (print_offset sk_prev)
- refcount sec_len
- (* print_bitstring sec_desc -- suppress this *)
-
-(* Store lists of records we encounter (lists of offsets). *)
-let nk_records = ref []
-and vk_records = ref []
-and sk_records = ref []
-
-(* Functions to visit each block, starting at the root. Each block
- * that we visit is printed.
- *)
-let rec visit_nk ?(nk_is_root = false) nk =
- let (_, _, bits) = lookup "visit_nk" nk in
- mark_visited nk;
- (bitmatch bits with
- | { :nk_fields } ->
- fprintf_nk stdout nk;
-
- nk_records := nk :: !nk_records;
-
- (* Check the isroot flag is only set on the root node. *)
- assert (isroot = nk_is_root);
-
- if unknownflag8000 then
- eprintf "NK %s unknownflag8000 is set\n" (print_offset nk);
- if unknownflag4000 then
- eprintf "NK %s unknownflag4000 is set\n" (print_offset nk);
- if unknownflag2000 then
- eprintf "NK %s unknownflag2000 is set\n" (print_offset nk);
- if unknownflag1000 then
- eprintf "NK %s unknownflag1000 is set\n" (print_offset nk);
- if unknownflag0800 then
- eprintf "NK %s unknownflag0800 is set\n" (print_offset nk);
- if unknownflag0400 then
- eprintf "NK %s unknownflag0400 is set\n" (print_offset nk);
- if unknown1 <> 0_l then
- eprintf "NK %s unknown1 <> 0 (%08lx)\n" (print_offset nk) unknown1;
- if unknown2_userflags <> 0 then
- eprintf "NK %s unknown2_userflags <> 0 (%x)\n"
- (print_offset nk) unknown2_userflags;
- if unknown2_virtcontrolflags <> 0 then
- eprintf "NK %s unknown2_virtcontrolflags <> 0 (%x)\n"
- (print_offset nk) unknown2_virtcontrolflags;
- if unknown2_debug <> 0 then
- eprintf "NK %s unknown2_debug <> 0 (%x)\n"
- (print_offset nk) unknown2_debug;
- if unknown3 <> 0_l then
- eprintf "NK %s unknown3 <> 0 (%08lx)\n" (print_offset nk) unknown3;
- if unknown6 <> 0_l then
- eprintf "NK %s unknown6 <> 0 (%08lx)\n" (print_offset nk) unknown6;
-
- (* -- common, assume it's not an error
- if classname = -1 then
- eprintf "NK %s has no classname\n" (print_offset nk);
- if classname_len = 0 then
- eprintf "NK %s has zero-length classname\n" (print_offset nk);
- *)
- if sk = -1 then
- eprintf "NK %s has no sk-record\n" (print_offset nk);
- if name_len = 0 then
- eprintf "NK %s has zero-length name\n" (print_offset nk);
-
- (* Visit the values first at this node. *)
- let max_data_len, max_name_len =
- if vallist <> -1 then
- visit_vallist nr_values vallist
- else
- 0, 0 in
-
- if max_vk_data_len < max_data_len then
- eprintf "NK %s nk.max_vk_data_len (%d) < actual max data_len (%d)\n"
- (print_offset nk) max_vk_data_len max_data_len;
-
- if max_vk_name_len < max_name_len * 2 then
- eprintf "NK %s nk.max_vk_name_len (%d) < actual max name_len * 2 (%d)\n"
- (print_offset nk) max_vk_name_len (max_name_len * 2);
-
- (* Visit the subkeys of this node. *)
- if subkeys <> -1 then (
- let counted, max_name_len, _ = visit_subkeys subkeys in
-
- if counted <> nr_subkeys then
- failwithf "%s: incorrect count of subkeys (%d, counted %d) in subkey list at %s\n"
- basename nr_subkeys counted (print_offset subkeys);
-
- if max_subkey_name_len < max_name_len * 2 then
- eprintf "NK %s nk.max_subkey_name_len (%d) < actual max name_len * 2 (%d)\n"
- (print_offset nk) max_subkey_name_len (max_name_len * 2);
- );
-
- (* Visit the sk-record and classname. *)
- if sk <> -1 then
- visit_sk sk;
- if classname <> -1 then
- visit_classname classname classname_len;
-
- | {_} ->
- failwithf "%s: invalid nk block at offset %s\n"
- basename (print_offset nk)
- )
-
-and visit_vallist nr_values vallist =
- let (seg_len, _, bits) = lookup "visit_vallist" vallist in
- mark_visited vallist;
- printf "VL %s %d %d\n" (print_offset vallist) nr_values seg_len;
- visit_values_in_vallist nr_values vallist bits
-
-and visit_values_in_vallist nr_values vallist bits =
- if nr_values > 0 then (
- bitmatch bits with
- | { rest : -1 : bitstring } when bitstring_length rest = 0 ->
- assert (nr_values = 0);
- 0, 0
-
- | { value : 4*8 : littleendian, bind (get_offset value);
- rest : -1 : bitstring } ->
- let data_len, name_len = visit_vk value in
- let max_data_len, max_name_len =
- visit_values_in_vallist (nr_values-1) vallist rest in
- max max_data_len data_len, max max_name_len name_len
-
- | {_} ->
- failwithf "%s: invalid offset in value list at %s\n"
- basename (print_offset vallist)
- ) else 0, 0
-
-and visit_vk vk =
- let (_, _, bits) = lookup "visit_vk" vk in
- mark_visited vk;
-
- (bitmatch bits with
- | { :vk_fields } ->
- fprintf_vk stdout vk;
-
- let is_inline, data_len = data_len in
-
- if unknown1 <> 0 then
- eprintf "VK %s unknown1 flags set (%02x)\n"
- (print_offset vk) unknown1;
- if unknown2 <> 0 then
- eprintf "VK %s unknown2 flags set (%02x)\n"
- (print_offset vk) unknown2;
- if unknown3 <> 0 then
- eprintf "VK %s unknown3 flags set (%04x)\n"
- (print_offset vk) unknown3;
-
- (* Note this is common for default [ie. zero-length] key names. *)
- if not nameisascii && name_len > 0 then
- eprintf "VK %s has non-ASCII name flag set (name is %s)\n"
- (print_offset vk) (print_binary_string name);
-
- vk_records := vk :: !vk_records;
- (match data with
- | Inline data -> ()
- | Offset offset ->
- let _ = lookup "visit_vk (data)" offset in
- mark_visited offset
- );
-
- data_len, name_len
-
- | {_} ->
- failwithf "%s: invalid vk block at offset %s\n"
- basename (print_offset vk)
- )
-
-(* Visits subkeys, recursing through intermediate lf/lh/ri structures,
- * and returns the number of subkeys actually seen.
- *)
-and visit_subkeys subkeys =
- let (_, _, bits) = lookup "visit_subkeys" subkeys in
- mark_visited subkeys;
- (bitmatch bits with
- | { "lf" : 2*8 : string;
- len : 2*8 : littleendian; (* number of subkeys of this node *)
- rest : len*8*8 : bitstring } ->
- printf "LF %s %d\n" (print_offset subkeys) len;
- visit_subkeys_in_lf_list false subkeys len rest
-
- | { "lh" : 2*8 : string;
- len : 2*8 : littleendian; (* number of subkeys of this node *)
- rest : len*8*8 : bitstring } ->
- printf "LF %s %d\n" (print_offset subkeys) len;
- visit_subkeys_in_lf_list true subkeys len rest
-
- | { "ri" : 2*8 : string;
- len : 2*8 : littleendian;
- rest : len*4*8 : bitstring } ->
- printf "RI %s %d\n" (print_offset subkeys) len;
- visit_subkeys_in_ri_list subkeys len rest
-
- (* In theory you can have an li-record here, but we've never
- * seen one.
- *)
-
- | { "nk" : 2*8 : string } ->
- visit_nk subkeys;
- let name, name_len = name_of_nk subkeys in
- 1, name_len, name
-
- | {_} ->
- failwithf "%s: invalid subkey node found at %s\n"
- basename (print_offset subkeys)
- )
-
-and visit_subkeys_in_lf_list newstyle_hash subkeys_top len bits =
- if len > 0 then (
- bitmatch bits with
- | { rest : -1 : bitstring } when bitstring_length rest = 0 ->
- assert (len = 0);
- 0, 0, ""
-
- | { offset : 4*8 : littleendian, bind (get_offset offset);
- hash : 4*8 : bitstring;
- rest : -1 : bitstring } ->
- let c1, name_len1, name = visit_subkeys offset in
-
- check_hash offset newstyle_hash hash name;
-
- let c2, name_len2, _ =
- visit_subkeys_in_lf_list newstyle_hash subkeys_top (len-1) rest in
- c1 + c2, max name_len1 name_len2, ""
-
- | {_} ->
- failwithf "%s: invalid subkey in lf/lh list at %s\n"
- basename (print_offset subkeys_top)
- ) else 0, 0, ""
-
-and visit_subkeys_in_ri_list subkeys_top len bits =
- if len > 0 then (
- bitmatch bits with
- | { rest : -1 : bitstring } when bitstring_length rest = 0 ->
- assert (len = 0);
- 0, 0, ""
-
- | { offset : 4*8 : littleendian, bind (get_offset offset);
- rest : -1 : bitstring } ->
- let c1, name_len1, _ = visit_subkeys offset in
- let c2, name_len2, _ =
- visit_subkeys_in_ri_list subkeys_top (len-1) rest in
- c1 + c2, max name_len1 name_len2, ""
-
- | {_} ->
- failwithf "%s: invalid subkey in ri list at %s\n"
- basename (print_offset subkeys_top)
- ) else 0, 0, ""
-
-and check_hash offset newstyle_hash hash name =
- if not newstyle_hash then (
- (* Old-style lf record hash the first four bytes of the name
- * as the has.
- *)
- let len = String.length name in
- let name_bits =
- if len >= 4 then
- bitstring_of_string (String.sub name 0 4)
- else (
- let zeroes = zeroes_bitstring ((4-len)*8) in
- concat [bitstring_of_string name; zeroes]
- ) in
- if not (equals hash name_bits) then
- eprintf "LF incorrect hash for name %s, expected %s, actual %s\n"
- name (print_bitstring name_bits) (print_bitstring hash)
- ) else (
- (* New-style lh record has a proper hash. *)
- let actual = bitmatch hash with { hash : 4*8 : littleendian } -> hash in
- let h = ref 0_l in
- String.iter (
- fun c ->
- h := Int32.mul !h 37_l;
- h := Int32.add !h (Int32.of_int (Char.code (Char.uppercase c)))
- ) name;
- if actual <> !h then
- eprintf "LH incorrect hash for name %s, expected 0x%08lx, actual 0x%08lx\n"
- name !h actual
- )
-
-and name_of_nk nk =
- let (_, _, bits) = lookup "name_of_nk" nk in
- bitmatch bits with
- | { :nk_fields } -> name, name_len
-
-and visit_sk sk =
- let (_, _, bits) = lookup "visit_sk" sk in
- if is_not_visited sk then (
- mark_visited sk;
- (bitmatch bits with
- | { :sk_fields } ->
- fprintf_sk stdout sk;
-
- if unknown1 <> 0 then
- eprintf "SK %s unknown1 <> 0 (%04x)\n" (print_offset sk) unknown1;
-
- sk_records := sk :: !sk_records
-
- | {_} ->
- failwithf "%s: invalid sk-record at %s\n"
- basename (print_offset sk)
- )
- )
-
-and visit_classname classname classname_len =
- let (seg_len, _, bits) = lookup "visit_classname" classname in
- mark_visited classname;
- assert (seg_len >= classname_len);
- printf "CL %s %s\n" (print_offset classname) (print_bitstring bits)
-
-let () =
- visit_nk ~nk_is_root:true root_key
-
-(* These are immutable now. *)
-let nk_records = !nk_records
-let vk_records = !vk_records
-let sk_records = !sk_records
-
-(* So we can rapidly tell what is an nk/vk/sk offset. *)
-let nk_set =
- List.fold_left (fun set offs -> IntSet.add offs set) IntSet.empty nk_records
-let vk_set =
- List.fold_left (fun set offs -> IntSet.add offs set) IntSet.empty vk_records
-let sk_set =
- List.fold_left (fun set offs -> IntSet.add offs set) IntSet.empty sk_records
-
-(* Now after visiting all the blocks, are there any used blocks which
- * are unvisited? If there are any then that would indicate either (a)
- * that the hive contains unreferenced blocks, or (b) that there are
- * referenced blocks that we did not visit because we don't have a full
- * understanding of the hive format.
- *
- * Windows 7 registries often contain a few of these -- not clear
- * how serious they are, but don't fail here.
- *)
-let () =
- let unvisited = unvisited_blocks () in
- IntMap.iter (
- fun offset block ->
- match block with
- | (_, false, _) -> () (* ignore unused blocks *)
- | (seg_len, true, _) ->
- eprintf "used block %s (length %d) is not referenced\n"
- (print_offset offset) seg_len
- ) unvisited
-
-(* Check the SKs are:
- * (a) linked into a single circular list through the sk_prev/sk_next
- * pointers
- * (b) refcounts are correct
- *)
-let () =
- if List.length sk_records > 0 then (
- let sk0 = List.hd sk_records in (* start at any arbitrary sk *)
- (* This loop follows the chain of sk pointers until we arrive
- * back at the original, checking prev/next are consistent.
- *)
- let rec loop visited prevsk sk =
- if sk <> sk0 then (
- if not (IntSet.mem sk sk_set) then
- eprintf "SK %s not an sk-record (faulty sk_next somewhere)\n"
- (print_offset sk)
- else (
- let _, _, bits = lookup "loop sk circular list" sk in
- bitmatch bits with
- | { :sk_fields } ->
- if sk_prev <> prevsk then
- eprintf "SK %s sk_prev != previous sk (%s, %s)\n"
- (print_offset sk)
- (print_offset sk_prev) (print_offset prevsk);
- if IntSet.mem sk visited then
- eprintf "SK %s already visited (bad circular list)\n"
- (print_offset sk);
- let visited = IntSet.add sk visited in
- loop visited sk sk_next
- )
- )
- in
- let _, _, bits = lookup "start sk circular list" sk0 in
- (bitmatch bits with
- | { :sk_fields } ->
- loop IntSet.empty sk_prev sk0
- );
-
- (* For every nk-record, if it references an sk-record count that,
- * then check this matches the refcounts in the sk-records
- * themselves.
- *)
- let refcounts = Counter.create () in
- List.iter (
- fun nk ->
- let _, _, bits = lookup "sk refcounter (nk)" nk in
- (bitmatch bits with
- | { :nk_fields } ->
- Counter.incr refcounts sk
- )
- ) nk_records;
-
- List.iter (
- fun sk ->
- let _, _, bits = lookup "sk refcounter (sk)" sk in
- (bitmatch bits with
- | { :sk_fields } ->
- let actual = Counter.get refcounts sk in
- if actual <> refcount then
- eprintf "SK %s incorrect refcount (actual %d, in file %d)\n"
- (print_offset sk) actual refcount
- )
- ) sk_records
- )
git.annexia.org / libguestfs.git / blobdiff