enable scrub on Debian
[libguestfs.git] / hivex / tools / visualizer.ml
index da79bee..5b7ac79 100644 (file)
@@ -408,19 +408,27 @@ let bitmatch nk_fields =
     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 two 16 bit
+     * 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 second field is often non-zero, but the purpose is unknown.
-     * In the hives we examined it had values 0, 1, 0x20, 0x21, 0xa0,
-     * 0xa1, 0xe1, suggesting some sort of flags.
+     * 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 : 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.
@@ -453,7 +461,7 @@ let fprintf_nk chan nk =
   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 %04x %08lx %d %d %08lx %d %d %s\n"
+        "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 ".")
@@ -476,26 +484,27 @@ let fprintf_nk chan nk =
         (print_offset subkeys) subkeys_vol
         nr_values (print_offset vallist)
         (print_offset sk) (print_offset classname)
-        max_subkey_name_len unknown2 unknown3
-        max_vk_name_len max_vk_data_len unknown6
+        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;
-    (* No one documents the important fact that data_len can have the
-     * top bit set (randomly or is it meaningful?).  The length can
-     * also be 0 (or 0x80000000) if the data type is NONE.
+    (* 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 data_len = Int32.logand data_len 0x7fff_ffff_l in
-        Int32.to_int data_len
+        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
       );
-    (* Inline data if len <= 4, offset otherwise.
-     *
-     * The data itself depends on the type field.
+    (* 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
@@ -506,7 +515,8 @@ let bitmatch vk_fields =
      *)
     data : 4*8
       : bitstring, bind (
-        if data_len <= 4 then
+        let is_inline, data_len = data_len in
+        if is_inline then
           Inline (takebits (data_len*8) data)
         else (
           let offset =
@@ -537,9 +547,10 @@ let fprintf_vk chan vk =
         | Offset offset ->
             let (_, _, bits) = lookup "fprintf_vk (data)" offset in
             bits in
-      fprintf chan "VK %s %s %d %s%s %s %08x %s %08x %08x\n"
+      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 data_len
+        name (if is_inline then "inline" else "-") data_len
         (match data with
          | Inline _ -> ""
          | Offset offset -> "["^print_offset offset^"]")
@@ -601,8 +612,15 @@ let rec visit_nk ?(nk_is_root = false) nk =
          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 <> 0 then
-         eprintf "NK %s unknown2 <> 0 (%04x)\n" (print_offset nk) unknown2;
+       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
@@ -636,7 +654,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"
@@ -691,6 +709,8 @@ and visit_vk vk =
    | { :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;
@@ -728,11 +748,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 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 subkeys len rest
+       visit_subkeys_in_lf_list true subkeys len rest
 
    | { "ri" : 2*8 : string;
        len : 2*8 : littleendian;
@@ -746,55 +772,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