-
Notifications
You must be signed in to change notification settings - Fork 9
/
Dexdumper.hs
313 lines (287 loc) · 11.7 KB
/
Dexdumper.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
{-# LANGUAGE OverloadedStrings #-}
module Main ( main ) where
import Control.Monad
import Data.Bits
import qualified Data.ByteString.Char8 as CBS
import qualified Data.ByteString.Lazy.Char8 as LBS
import qualified Data.ByteString.Lazy.Builder as B
import qualified Data.ByteString.Lazy.Builder.ASCII as A
import Data.ByteString.Lazy.Builder (Builder)
import qualified Data.Map as Map
import Data.List
import Data.Maybe
import Data.Monoid
import Data.Word
import System.Environment
import Dalvik.AccessFlags
import Dalvik.Apk
import Dalvik.DebugInfo
import Dalvik.Instruction
import Dalvik.Printer
import Dalvik.Types
processFile :: FilePath -> IO ()
processFile f = do
putStrLn $ "Processing '" ++ f ++ "'..."
edex <- loadDexFromAnyIO f
case edex of
Left err -> putStrLn err
Right dex -> do
hdrLines f (dexHeader dex)
mapM_ (classLines dex) . Map.toList . dexClasses $ dex
p ""
escape :: String -> String
escape [] = []
escape ('\0' : s) = '\\' : '0' : escape s
escape ('\n' : s) = '\\' : 'n' : escape s
escape (c : s) = c : escape s
escapebs :: CBS.ByteString -> CBS.ByteString
escapebs = CBS.pack . escape . CBS.unpack
pl :: [Builder] -> IO ()
pl = LBS.putStrLn . B.toLazyByteString . mconcat
p :: Builder -> IO ()
p = LBS.putStrLn . B.toLazyByteString
word24HexFixed :: Word32 -> Builder
word24HexFixed w = bs +++ ws
where bs = A.word8HexFixed . fromIntegral $ (w .&. 0x00FF0000) `shiftR` 16
ws = A.word16HexFixed . fromIntegral $ w .&. 0x0000FFFF
word20HexFixed :: Word32 -> Builder
word20HexFixed w = bs +++ ws
where bs = A.word8Hex . fromIntegral $ (w .&. 0x000F0000) `shiftR` 16
ws = A.word16HexFixed . fromIntegral $ w .&. 0x0000FFFF
hdrLines :: FilePath -> DexHeader -> IO ()
hdrLines f hdr = do
pl [ "Opened "
, squotes (B.string8 f)
, ", DEX version "
, squotes . B.byteString . escapebs . CBS.take 3 $
dexVersion hdr
]
p "DEX file header:"
p $ fld "magic" . squotes . B.byteString . escapebs .
CBS.append (dexMagic hdr) $ dexVersion hdr
p $ fld "checksum" . A.word32HexFixed $ dexChecksum hdr
p $ fld "signature" . sig $ dexSHA1 hdr
p $ fldn32 "file_size" $ dexFileLen hdr
p $ fldn32 "header_size" $ dexHdrLen hdr
p $ fldn32 "link_size" $ dexLinkSize hdr
p $ fldx "link_off" $ dexLinkOff hdr
p $ fldn32 "string_ids_size" $ dexNumStrings hdr
p $ fldx "string_ids_off" $ dexOffStrings hdr
p $ fldn32 "type_ids_size" $ dexNumTypes hdr
p $ fldx "type_ids_off" $ dexOffTypes hdr
p $ fldn32 "field_ids_size" $ dexNumFields hdr
p $ fldx "field_ids_off" $ dexOffFields hdr
p $ fldn32 "method_ids_size" $ dexNumMethods hdr
p $ fldx "method_ids_off" $ dexOffMethods hdr
p $ fldn32 "class_defs_size" $ dexNumClassDefs hdr
p $ fldx "class_defs_off" $ dexOffClassDefs hdr
p $ fldn32 "data_size" $ dexDataSize hdr
p $ fldx "data_off" $ dexDataOff hdr
where sig s = mconcat [ mconcat (take 2 s')
, "..."
, mconcat (drop 18 s')
]
where s' = map A.word8HexFixed s
fld :: String -> Builder -> Builder
fld n v = mconcat [ B.string7 (lstr 20 n), ": " , v ]
fldbroken :: String -> Builder -> Builder
fldbroken n v = mconcat [ B.string7 n, " : " , v ]
fldx :: String -> Word32 -> Builder
fldx n v = fld n $ mconcat [ A.word32Dec v, " (0x", word24HexFixed v, ")" ]
fldx4 :: String -> Word32 -> Builder
fldx4 n v =
fld n $
mconcat [ A.word32Dec v, " (0x", A.word16HexFixed (fromIntegral v), ")" ]
fldn16 :: String -> Word16 -> Builder
fldn16 n (-1) = fld n "-1"
fldn16 n v = fld n (A.word16Dec v)
fldn32 :: String -> Word32 -> Builder
fldn32 n (-1) = fld n "-1"
fldn32 n v = fld n (A.word32Dec v)
fldxs :: String -> Word32 -> Builder -> Builder
fldxs n v s =
fld n $ mconcat [ "0x", hp v, " (", s, ")" ]
where hp = if v >= 0x10000
then word20HexFixed
else (A.word16HexFixed . fromIntegral)
fldns :: String -> Word32 -> Builder -> Builder
fldns n (-1) _ = fld n "-1 (unknown)"
fldns n v s = fld n $ mconcat [ A.word32Dec v, " (", s, ")" ]
classLines :: DexFile -> (TypeId, Class) -> IO ()
classLines dex (i, cls) = do
p ""
pl [ "Class #", A.word16Dec i, " header:" ]
p $ fldn16 "class_idx" $ classId cls
p $ fldx4 "access_flags" $ classAccessFlags cls
p $ fldn16 "superclass_idx" $ classSuperId cls
p $ fldx "interfaces_off" $ classInterfacesOff cls
p $ fldn32 "source_file_idx" $ classSourceNameId cls
p $ fldx "annotations_off" $ classAnnotsOff cls
p $ fldx "class_data_off" $ classDataOff cls
p $ fldn32 "static_fields_size" $
fromIntegral $ length (classStaticFields cls)
p $ fldn32 "instance_fields_size" $
fromIntegral $ length (classInstanceFields cls)
p $ fldn32 "direct_methods_size" $
fromIntegral $ length (classDirectMethods cls)
p $ fldn32 "virtual_methods_size" $
fromIntegral $ length (classVirtualMethods cls)
p $ ""
pl [ "Class #", A.word16Dec i, " -" ]
p $ fld " Class descriptor" $ squotes $ getTypeName' dex (classId cls)
p $ fldxs " Access flags"
(classAccessFlags cls) (flagsString AClass (classAccessFlags cls))
p $ fld " Superclass" $ squotes $ getTypeName' dex (classSuperId cls)
p " Interfaces -"
mapM_ (interfaceLines dex) (zip [0..] (classInterfaces cls))
p " Static fields -"
mapM_ (fieldLines dex) (zip [0..] (classStaticFields cls))
p " Instance fields -"
mapM_ (fieldLines dex) (zip [0..] (classInstanceFields cls))
p " Direct methods -"
mapM_ (methodLines dex) (zip [0..] (classDirectMethods cls))
p " Virtual methods -"
mapM_ (methodLines dex) (zip [0..] (classVirtualMethods cls))
p $ fldns " source_file_idx"
(classSourceNameId cls)
(getStr' dex (classSourceNameId cls))
interfaceLines :: DexFile -> (Word32, TypeId) -> IO ()
interfaceLines dex (n, i) =
p $ fldbroken (" #" ++ show n) (squotes (getTypeName' dex i))
fieldLines :: DexFile -> (Word32, EncodedField) -> IO ()
fieldLines dex (n, f) =
case getField dex (fieldId f) of
Nothing ->
p $ "<unknown field ID: " +++ A.word16HexFixed (fieldId f) +++ ">"
Just field -> do
pl [ " #", A.word32Dec n
, " : (in ", clsName, ")" ]
p $ fld " name" . squotes . getStr' dex . fieldNameId $ field
p $ fld " type" . squotes . getTypeName' dex . fieldTypeId $ field
p $ fldxs " access"
(fieldAccessFlags f)
(flagsString AField (fieldAccessFlags f))
where clsName = getTypeName' dex . fieldClassId $ field
methodLines :: DexFile -> (Word32, EncodedMethod) -> IO ()
methodLines dex (n, m) =
let mmeth = getMethod dex (methId m)
mproto :: Maybe Proto
mproto = join ((getProto dex . methProtoId) `fmap` mmeth) in
case (mmeth, mproto) of
(Just method, Just proto) -> do
pl [ " #", A.word32Dec n , " : (in " , clsName, ")" ]
p $ fld " name" . squotes . getStr' dex . methNameId $ method
p $ fld " type" $ squotes $ protoDesc dex proto
p $ fldxs " access" flags (flagsString AMethod flags)
maybe (p " code : (none)" >> p "")
(codeLines dex flags (methId m))
(methCode m)
where flags = methAccessFlags m
clsName = getTypeName' dex . methClassId $ method
(Nothing, _) ->
p $ "<unknown method ID: " +++ A.word16HexFixed (methId m) +++ ">"
(Just method, Nothing) ->
p $ "<unknown prototype ID: " +++
A.word16HexFixed (methProtoId method) +++
">"
codeLines :: DexFile -> AccessFlags -> MethodId -> CodeItem -> IO ()
codeLines dex flags mid code = do
p " code -"
p $ fldn16 " registers" $ codeRegs code
p $ fldn16 " ins" $ codeInSize code
p $ fldn16 " outs" $ codeOutSize code
p $ fld " insns size" $
A.word32Dec (fromIntegral (length insnUnits)) +++ " 16-bit code units"
p $ word24HexFixed nameAddr +++
": |[" +++
word24HexFixed nameAddr +++ "] " +++ methodStr dex mid
insnText
let ntries = fromIntegral (length tries)
p $ fld " catches"
(if null tries then "(none)" else A.word32Dec ntries)
mapM_ (tryLines dex code) tries
p $ fld " positions" ""
positionText
p $ fld " locals" ""
unless (Map.null (dbgLocals debugState)) plocals
p ""
where tries = codeTryItems code
insnUnits = codeInsns code
insns = decodeInstructions insnUnits
addr = codeInsnOff code
nameAddr = addr - 16 -- Ick!
debugState = either (const emptyDebugState) id $
executeDebugInsns dex code flags mid
positionText = mapM_ ppos . reverse . dbgPositions $ debugState
ppos (PositionInfo a l) = p $
" 0x" +++ A.word16HexFixed (fromIntegral a) +++
" line=" +++ A.word32Dec l
plocals = (mapM_ plocal .
sortBy cmpLocal .
filter hasName)
[ (r, l) | (r, ls) <- Map.toList (dbgLocals debugState)
, l <- ls ]
cmpLocal (_, LocalInfo n _ e _ _ _) (_, LocalInfo n' _ e' _ _ _) =
compare (e, n) (e', n')
hasName (_, LocalInfo _ _ _ nid _ _) = nid /= (-1)
plocal (r, LocalInfo _ s e nid tid sid) = p $
" 0x" +++ A.word16HexFixed (fromIntegral s) +++
" - 0x" +++ A.word16HexFixed (fromIntegral e) +++ " reg=" +++
A.word32Dec r +++ " " +++ nstr nid +++ " " +++ tstr tid +++
" " +++ (if sid == -1 then "" else nstr sid)
insnText = either
(\msg -> p . B.string7 $
"error parsing instructions: " ++ msg)
(insnLines dex addr 0 insnUnits)
insns
nstr nid = getStr' dex . fromIntegral $ nid
tstr tid = getTypeName' dex . fromIntegral $ tid
insnLines :: DexFile -> Word32 -> Word32 -> [Word16] -> [Instruction]
-> IO ()
insnLines _ _ _ [] [] = return ()
insnLines _ _ _ [] is = p . B.string7 $
"ERROR: No more code units (" ++ show is ++ " instructions left)"
insnLines _ _ _ ws [] = p . B.string7 $
"ERROR: No more instructions (" ++ show (length ws) ++ " code units left)"
insnLines dex addr off ws (i:is) = do
pl [ word24HexFixed addr, ": "
, unitStr, "|"
, A.word16HexFixed (fromIntegral off), ": "
, istr
]
insnLines dex (addr + (l'*2)) (off + l') ws' is
where (iws, ws') = splitAt l ws
istrs = map showCodeUnit iws
istrs' | length istrs < 8 = take 8 $ istrs ++ repeat " "
| otherwise = take 7 istrs ++ ["... "]
l = insnUnitCount i
l' = fromIntegral l
unitStr = mconcat . intersperse " " $ istrs'
showCodeUnit w =
A.word8HexFixed (fromIntegral (w .&. 0x00FF)) +++
A.word8HexFixed (fromIntegral $ ((w .&. 0xFF00) `shiftR` 8))
istr = insnString dex off i
tryLines :: DexFile -> CodeItem -> TryItem -> IO ()
tryLines dex code try = do
pl [ " 0x"
, A.word16HexFixed (fromIntegral (tryStartAddr try))
, " - 0x"
, A.word16HexFixed (fromIntegral end)
]
mapM_ pl [ [ " "
, getTypeName' dex ty
, " -> 0x"
, A.word16HexFixed (fromIntegral addr)
] |
(ty, addr) <- handlers
]
mapM_ (\addr -> p $ " <any> -> 0x" +++
A.word16HexFixed (fromIntegral addr))
(mapMaybe chAllAddr catches)
where end = tryStartAddr try + fromIntegral (tryInsnCount try)
catches = filter
((== tryHandlerOff try) . fromIntegral . chHandlerOff)
(codeHandlers code)
handlers = mconcat $ map chHandlers catches
main :: IO ()
main = mapM_ processFile =<< getArgs