{-# OPTIONS_HADDOCK hide #-}


-- Parser that can be used to read dumps of binaries.
-- Let $1 be the binary. For ELF files one can use readelf, for MachO files one can use otool.
--
-- ELF:
--      readelf --wide $1 | grep . | grep -v "Hex dump" | sed -e 's/^[[:space:]]*//g' -e 's/[[:space:]]*\$//g' | tr -s ' ' | cut -d ' ' -f1,2,3,4,5
--
-- MACHO:
--      otool -s $current_seg_name $current_sect_name $1 | tail -n +2
--
--
-- Example input line:
--   1000b3f80 ffff4889 fb488b05 acc01400 488b0048 
--
--      ^       ^     
--      |       |
--   ADDRESS   DATA
--
--   ADDRESS is in hex format without 0x

module Parser.ParserDump where

import Text.Parsec.Token
import Text.Parsec.Char (hexDigit)
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Number
import qualified Data.IntMap as IM
import Data.Word (Word8)
import Numeric (readHex)
import Data.List.Split (chunksOf)
import Data.Char

isWhiteSpace :: Char -> Bool
isWhiteSpace :: Char -> Bool
isWhiteSpace Char
c
  | Word
uc Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
0x377 = Word
uc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
32 Bool -> Bool -> Bool
|| Word
uc Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
9
  | Bool
otherwise = Char -> Bool
isSpace Char
c
  where
    uc :: Word
uc = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c) :: Word



whitespace :: ParsecT [Char] u Identity Char
whitespace  = (Char -> Bool) -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isWhiteSpace ParsecT [Char] u Identity Char
-> [Char] -> ParsecT [Char] u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"space"
whitespaces :: ParsecT [Char] u Identity ()
whitespaces = ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Char] u Identity Char
forall u. ParsecT [Char] u Identity Char
whitespace  ParsecT [Char] u Identity ()
-> [Char] -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> [Char] -> ParsecT s u m a
<?> [Char]
"white space"

-- a hex sequence of 1 or more bytes
-- E.g.: 10631e00
bytes :: ParsecT [Char] u Identity [Word8]
bytes = do
  [Char]
digits <- ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
hexDigit
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  [Word8] -> ParsecT [Char] u Identity [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Word8] -> ParsecT [Char] u Identity [Word8])
-> [Word8] -> ParsecT [Char] u Identity [Word8]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Word8) -> [[Char]] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word8) -> ([Char] -> Integer) -> [Char] -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, [Char]) -> Integer
forall a b. (a, b) -> a
fst ((Integer, [Char]) -> Integer)
-> ([Char] -> (Integer, [Char])) -> [Char] -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Integer, [Char])] -> (Integer, [Char])
forall a. [a] -> a
head ([(Integer, [Char])] -> (Integer, [Char]))
-> ([Char] -> [(Integer, [Char])]) -> [Char] -> (Integer, [Char])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [(Integer, [Char])]
forall a. (Eq a, Num a) => ReadS a
readHex) ([[Char]] -> [Word8]) -> [[Char]] -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> [Char] -> [[Char]]
forall e. Int -> [e] -> [[e]]
chunksOf Int
2 [Char]
digits

data_line :: ParsecT [Char] u Identity [(Int, Word8)]
data_line = do
  ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Char] u Identity Char
forall u. ParsecT [Char] u Identity Char
ignored_line
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  Int
a <- GenParser Char u Int -> GenParser Char u Int
forall tok st a. GenParser tok st a -> GenParser tok st a
try ([Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"0x" ParsecT [Char] u Identity [Char]
-> GenParser Char u Int -> GenParser Char u Int
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenParser Char u Int
forall i st. Integral i => CharParser st i
hexnum)
       GenParser Char u Int
-> GenParser Char u Int -> GenParser Char u Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
       GenParser Char u Int
forall i st. Integral i => CharParser st i
hexnum 
  ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
  [[Word8]]
bs <- ParsecT [Char] u Identity [Word8]
-> ParsecT [Char] u Identity [[Word8]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] u Identity [Word8]
forall u. ParsecT [Char] u Identity [Word8]
bytes
  ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity [Char]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
  ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  [(Int, Word8)] -> ParsecT [Char] u Identity [(Int, Word8)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Word8)] -> ParsecT [Char] u Identity [(Int, Word8)])
-> [(Int, Word8)] -> ParsecT [Char] u Identity [(Int, Word8)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Word8] -> [(Int, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
a..] ([[Word8]] -> [Word8]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Word8]]
bs)
 
dump :: ParsecT [Char] u Identity (IntMap Word8)
dump = do
  [[(Int, Word8)]]
ds <- ParsecT [Char] u Identity [(Int, Word8)]
-> ParsecT [Char] u Identity [[(Int, Word8)]]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT [Char] u Identity [(Int, Word8)]
-> ParsecT [Char] u Identity [(Int, Word8)]
forall tok st a. GenParser tok st a -> GenParser tok st a
try ParsecT [Char] u Identity [(Int, Word8)]
forall u. ParsecT [Char] u Identity [(Int, Word8)]
data_line)
  IntMap Word8 -> ParsecT [Char] u Identity (IntMap Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap Word8 -> ParsecT [Char] u Identity (IntMap Word8))
-> IntMap Word8 -> ParsecT [Char] u Identity (IntMap Word8)
forall a b. (a -> b) -> a -> b
$ [(Int, Word8)] -> IntMap Word8
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, Word8)] -> IntMap Word8) -> [(Int, Word8)] -> IntMap Word8
forall a b. (a -> b) -> a -> b
$ [[(Int, Word8)]] -> [(Int, Word8)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Int, Word8)]]
ds
  

dumps :: ParsecT [Char] u Identity (IntMap Word8)
dumps = do
  [IntMap Word8]
ds <- ParsecT [Char] u Identity (IntMap Word8)
-> ParsecT [Char] u Identity [IntMap Word8]
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT [Char] u Identity (IntMap Word8)
forall u. ParsecT [Char] u Identity (IntMap Word8)
dump 
  ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ParsecT [Char] u Identity Char
forall u. ParsecT [Char] u Identity Char
ignored_line
  ParsecT [Char] u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  IntMap Word8 -> ParsecT [Char] u Identity (IntMap Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap Word8 -> ParsecT [Char] u Identity (IntMap Word8))
-> IntMap Word8 -> ParsecT [Char] u Identity (IntMap Word8)
forall a b. (a -> b) -> a -> b
$ [IntMap Word8] -> IntMap Word8
forall (f :: * -> *) a. Foldable f => f (IntMap a) -> IntMap a
IM.unions [IntMap Word8]
ds

-- The parse function.
-- Takes as input a filename f and produces a mapping of addresses (Int) to bytes (Word8)
parse_dump :: String -> IO (Either ParseError (IM.IntMap Word8))
parse_dump :: [Char] -> IO (Either ParseError (IntMap Word8))
parse_dump [Char]
f = Parser (IntMap Word8)
-> [Char] -> IO (Either ParseError (IntMap Word8))
forall a. Parser a -> [Char] -> IO (Either ParseError a)
parseFromFile Parser (IntMap Word8)
forall u. ParsecT [Char] u Identity (IntMap Word8)
dumps [Char]
f









ignored_line :: ParsecT [Char] u Identity Char
ignored_line = 
  (ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do 
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    [Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"Contents of"
    ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ([Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
    ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  ))
  ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do 
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    [Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"<skipping contents of"
    ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ([Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
    ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  ))
  ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do 
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    [Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"NOTE"
    ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ([Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
    ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  ))
  ParsecT [Char] u Identity Char
-> ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity Char
forall tok st a. GenParser tok st a -> GenParser tok st a
try (do 
    ParsecT [Char] u Identity ()
forall u. ParsecT [Char] u Identity ()
whitespaces
    [Char] -> ParsecT [Char] u Identity [Char]
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m [Char]
string [Char]
"("
    ParsecT [Char] u Identity Char -> ParsecT [Char] u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m ()
skipMany ([Char] -> ParsecT [Char] u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char] -> ParsecT s u m Char
noneOf [Char]
"\n")
    ParsecT [Char] u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  ))