{-# LANGUAGE Strict #-}


{-# OPTIONS_HADDOCK hide #-}

-- Parser that can be used to read section info supplied by bash script "dump_macho.sh"
--
-- Example input:
--
-- (__TEXT,__text)
--   addr = 0x0000000100002a94
--   size = 0x0000000000000f69
--
-- | (__DATA,__common)
-- |   addr = 0x00000001000041d0
-- |   size = 0x0000000000000010

module Parser.ParserSections where

import Generic.Binary

import Text.Parsec.Token
import Text.ParserCombinators.Parsec
import Text.ParserCombinators.Parsec.Number

isWhiteSpace :: Char -> Bool
isWhiteSpace Char
'\t' = Bool
True
isWhiteSpace Char
'\f' = Bool
True
isWhiteSpace Char
'\v' = Bool
True
isWhiteSpace Char
' ' = Bool
True
isWhiteSpace Char
_ = Bool
False 

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


hexnum_with_0x :: ParsecT String u Identity Word64
hexnum_with_0x = do
  String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"0x"
  ParsecT String u Identity Word64
forall i st. Integral i => CharParser st i
hexnum


section_info :: ParsecT String u Identity (String, String, Word64, Word64)
section_info = do
  ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline

  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"("
  String
segname <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
",")
  String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
","
  String
sectname <- ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
noneOf String
")")
  String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
")"
  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline

  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"addr"
  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"="
  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  Word64
addr <- ParsecT String u Identity Word64
forall u. ParsecT String u Identity Word64
hexnum_with_0x
  ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline

  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"size"
  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"="
  ParsecT String u Identity ()
forall u. ParsecT String u Identity ()
whitespaces
  Word64
size <- ParsecT String u Identity Word64
forall u. ParsecT String u Identity Word64
hexnum_with_0x
  ParsecT String u Identity Char -> ParsecT String u Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String u Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
newline
  (String, String, Word64, Word64)
-> ParsecT String u Identity (String, String, Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return ((String, String, Word64, Word64)
 -> ParsecT String u Identity (String, String, Word64, Word64))
-> (String, String, Word64, Word64)
-> ParsecT String u Identity (String, String, Word64, Word64)
forall a b. (a -> b) -> a -> b
$ (String
segname,String
sectname,Word64
addr,Word64
size)

sections_info :: ParsecT String u Identity SectionsInfo
sections_info = do
  [(String, String, Word64, Word64)]
sis <- ParsecT String u Identity (String, String, Word64, Word64)
-> ParsecT String u Identity [(String, String, Word64, Word64)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT String u Identity (String, String, Word64, Word64)
forall u.
ParsecT String u Identity (String, String, Word64, Word64)
section_info
  ParsecT String u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
  let min :: Word64
min = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ ((String, String, Word64, Word64) -> Word64)
-> [(String, String, Word64, Word64)] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, Word64, Word64) -> Word64
forall a b c d. (a, b, c, d) -> c
get_min_address [(String, String, Word64, Word64)]
sis
  let max :: Word64
max = [Word64] -> Word64
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ ((String, String, Word64, Word64) -> Word64)
-> [(String, String, Word64, Word64)] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, Word64, Word64) -> Word64
forall a a b. Num a => (a, b, a, a) -> a
get_max_address [(String, String, Word64, Word64)]
sis
  SectionsInfo -> ParsecT String u Identity SectionsInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (SectionsInfo -> ParsecT String u Identity SectionsInfo)
-> SectionsInfo -> ParsecT String u Identity SectionsInfo
forall a b. (a -> b) -> a -> b
$ [(String, String, Word64, Word64)]
-> Word64 -> Word64 -> SectionsInfo
SectionsInfo [(String, String, Word64, Word64)]
sis Word64
min Word64
max
 where
  get_min_address :: (a, b, c, d) -> c
get_min_address (a
_,b
_,c
a,d
_)  = c
a
  get_max_address :: (a, b, a, a) -> a
get_max_address (a
_,b
_,a
a,a
si) = a
a a -> a -> a
forall a. Num a => a -> a -> a
+ a
si a -> a -> a
forall a. Num a => a -> a -> a
- a
1

-- The parse function.
-- Takes as input a filename f and produces a list of instructions
-- to lists of instructions.
parse_sections  :: String -> IO (Either ParseError SectionsInfo)
parse_sections :: String -> IO (Either ParseError SectionsInfo)
parse_sections = Parser SectionsInfo
-> String -> IO (Either ParseError SectionsInfo)
forall a. Parser a -> String -> IO (Either ParseError a)
parseFromFile Parser SectionsInfo
forall u. ParsecT String u Identity SectionsInfo
sections_info