diff options
| -rw-r--r-- | hivex/tools/visualizer.ml | 81 |
1 files changed, 61 insertions, 20 deletions
diff --git a/hivex/tools/visualizer.ml b/hivex/tools/visualizer.ml index da79beec..bc447b7a 100644 --- a/hivex/tools/visualizer.ml +++ b/hivex/tools/visualizer.ml @@ -636,7 +636,7 @@ let rec visit_nk ?(nk_is_root = false) nk = (* Visit the subkeys of this node. *) if subkeys <> -1 then ( - let counted, max_name_len = visit_subkeys subkeys in + 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" @@ -728,11 +728,17 @@ and visit_subkeys subkeys = let (_, _, bits) = lookup "visit_subkeys" subkeys in mark_visited subkeys; (bitmatch bits with - | { ("lf"|"lh") : 2*8 : string; + | { "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 subkeys len rest + 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; @@ -746,55 +752,90 @@ and visit_subkeys subkeys = | { "nk" : 2*8 : string } -> visit_nk subkeys; - let name_len = name_len_of_nk subkeys in - 1, name_len + 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 subkeys_top len bits = +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 + 0, 0, "" | { offset : 4*8 : littleendian, bind (get_offset offset); - _ (* hash *) : 4*8 : bitstring; + hash : 4*8 : bitstring; rest : -1 : bitstring } -> - let c1, name_len1 = visit_subkeys offset in - let c2, name_len2 = visit_subkeys_in_lf_list subkeys_top (len-1) rest in - c1 + c2, max name_len1 name_len2 + 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 + ) 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 + 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 + 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 + ) 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_len_of_nk nk = - let (_, _, bits) = lookup "name_len_of_nk" nk in +and name_of_nk nk = + let (_, _, bits) = lookup "name_of_nk" nk in bitmatch bits with - | { :nk_fields } -> name_len + | { :nk_fields } -> name, name_len and visit_sk sk = let (_, _, bits) = lookup "visit_sk" sk in |