lib/tools/visualizer_utils.ml

   1 (* Windows Registry reverse-engineering tool.
   2  * Copyright (C) 2010 Red Hat Inc.
   3  *
   4  * This program is free software; you can redistribute it and/or modify
   5  * it under the terms of the GNU General Public License as published by
   6  * the Free Software Foundation; either version 2 of the License, or
   7  * (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License along
  15  * with this program; if not, write to the Free Software Foundation, Inc.,
  16  * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
  17  *
  18  * For existing information on the registry format, please refer
  19  * to the following documents.  Note they are both incomplete
  20  * and inaccurate in some respects.
  21  *)
  22
  23 open ExtString
  24 open Printf
  25
  26 let failwithf fs = ksprintf failwith fs
  27
  28 (* Useful function to convert unknown bitstring fragments into
  29  * printable strings.
  30  *)
  31 let rec print_bitstring bits =
  32   let str = Bitstring.string_of_bitstring bits in
  33   print_binary_string str
  34 and print_binary_string str =
  35   let rec printable = function
  36     | '\x00' -> "\\0" | '\x01' -> "\\1" | '\x02' -> "\\2" | '\x03' -> "\\3"
  37     | '\x04' -> "\\4" | '\x05' -> "\\5" | '\x06' -> "\\6" | '\x07' -> "\\7"
  38     | ('\x08'..'\x31' as c)
  39     | ('\x7f'..'\xff' as c) -> sprintf "\\x%02x" (Char.code c)
  40     | ('\x32'..'\x7e' as c) -> String.make 1 c
  41   and repeat str = function
  42     | n when n <= 0 -> ""
  43     | n -> str ^ repeat str (n-1)
  44   in
  45   let chars = String.explode str in
  46   let rec loop acc = function
  47     | [] -> List.rev acc
  48     | x :: xs ->
  49         let rec loop2 i = function
  50           | y :: ys when x = y -> loop2 (i+1) ys
  51           | ys -> i, ys
  52         in
  53         let count, ys = loop2 1 xs in
  54         let acc = (count, x) :: acc in
  55         loop acc ys
  56   in
  57   let frags = loop [] chars in
  58   let frags =
  59     List.map (function
  60               | (nr, x) when nr <= 4 -> repeat (printable x) nr
  61               | (nr, x) -> sprintf "%s<%d times>" (printable x) nr
  62              ) frags in
  63   "\"" ^ String.concat "" frags ^ "\""
  64
  65 (* Convert an offset from the file to an offset.  The only special
  66  * thing is that 0xffffffff in the file is used as a kind of "NULL
  67  * pointer".  We map these null values to -1.
  68  *)
  69 let get_offset = function
  70   | 0xffffffff_l -> -1
  71   | i -> Int32.to_int i
  72
  73 (* Print an offset. *)
  74 let print_offset = function
  75   | -1 -> "NULL"
  76   | i -> sprintf "@%08x" i
  77
  78 (* Print time. *)
  79 let print_time t =
  80   let tm = Unix.gmtime t in
  81   sprintf "%04d-%02d-%02d %02d:%02d:%02d"
  82     (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
  83     tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec
  84
  85 (* Print UTF16LE. *)
  86 let print_utf16 str =
  87   let n = String.length str in
  88   if n land 1 <> 0 then
  89     print_binary_string str
  90   else (
  91     let rec loop i =
  92       if i < n-1 then (
  93         let c1 = Char.code (str.[i]) in
  94         let c2 = Char.code (str.[i+1]) in
  95         if c1 <> 0 || c2 <> 0 then (
  96           (* Well, this doesn't print non-7bit-ASCII ... *)
  97           let c =
  98             if c2 = 0 then String.make 1 (Char.chr c1)
  99             else sprintf "\\u%04d" (c2 * 256 + c1) in
 100           c :: loop (i+2)
 101         ) else []
 102       ) else []
 103     in
 104     let frags = loop 0 in
 105     "L\"" ^ String.concat "" frags ^ "\""
 106   )
 107
 108 (* A map of int -> anything. *)
 109 module IntMap = Map.Make (struct type t = int let compare = compare end)
 110
 111 (* A set of ints. *)
 112 module IntSet = Set.Make (struct type t = int let compare = compare end)
 113
 114 (* Print registry vk-record type field. *)
 115 let print_vk_type = function
 116   | 0 -> "NONE"
 117   | 1 -> "SZ"
 118   | 2 -> "EXPAND_SZ"
 119   | 3 -> "BINARY"
 120   | 4 -> "DWORD"
 121   | 5 -> "DWORD_BIG_ENDIAN"
 122   | 6 -> "LINK"
 123   | 7 -> "MULTI_SZ"
 124   | 8 -> "RESOURCE_LiST"
 125   | 9 -> "FULL_RESOURCE_DESCRIPTOR"
 126   | 10 -> "RESOURCE_REQUIREMENTS_LIST"
 127   | 11 -> "QWORD"
 128   | i -> sprintf "UNKNOWN_VK_TYPE_%d" i
 129
 130 (* XXX We should write a more efficient version of this and
 131  * push it into the bitstring library.
 132  *)
 133 let is_zero_bitstring bits =
 134   let len = Bitstring.bitstring_length bits in
 135   let zeroes = Bitstring.zeroes_bitstring len in
 136   0 = Bitstring.compare bits zeroes
 137
 138 let is_zero_guid = is_zero_bitstring
 139
 140 (* http://msdn.microsoft.com/en-us/library/aa373931(VS.85).aspx
 141  * Endianness of GUIDs is not clear from the MSDN documentation,
 142  * so this is just a guess.
 143  *)
 144 let print_guid bits =
 145   bitmatch bits with
 146   | { data1 : 4*8 : littleendian;
 147       data2 : 2*8 : littleendian;
 148       data3 : 2*8 : littleendian;
 149       data4_1 : 2*8 : littleendian;
 150       data4_2 : 6*8 : littleendian } ->
 151       sprintf "%08lX-%04X-%04X-%04X-%012LX" data1 data2 data3 data4_1 data4_2
 152   | { _ } ->
 153       assert false
 154
 155 (* Fold over little-endian 32-bit integers in a bitstring. *)
 156 let rec bitstring_fold_left_int32_le f a bits =
 157   bitmatch bits with
 158   | { i : 4*8 : littleendian;
 159       rest : -1 : bitstring } ->
 160       bitstring_fold_left_int32_le f (f a i) rest
 161   | { rest : -1 : bitstring } when Bitstring.bitstring_length rest = 0 -> a
 162   | { _ } ->
 163       invalid_arg "bitstring_fold_left_int32_le: length not a multiple of 32 bits"