{-# LANGUAGE PartialTypeSignatures , FlexibleContexts, Strict, DeriveGeneric, StandaloneDeriving #-}

module Instantiation.BinaryMacho (macho_read_file) where

import Base

import Generic.Binary

import Parser.ParserDump
import Parser.ParserSymbols
import Parser.ParserSections

import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.IntMap as IM
import qualified Data.IntSet as IS
import Data.Word 
import Data.List
import Data.Bits
import Data.Maybe (fromJust)
import Data.List.Extra (firstJust)
import qualified Data.ByteString as BS
import GHC.Generics
import qualified Data.Serialize as Cereal hiding (get,put)
import qualified Data.Text                  as T
import qualified Data.Text.Encoding         as T



data Macho = Macho {
  Macho -> IntMap Word8
macho_data :: IM.IntMap Word8,     -- writable data
  Macho -> IntMap Word8
macho_dump :: IM.IntMap Word8,     -- read only data
  Macho -> IntMap Symbol
macho_symbols :: IM.IntMap Symbol, -- symbol list
  Macho -> SectionsInfo
macho_sections :: SectionsInfo,    -- section info
  Macho -> [Word64]
macho_entry :: [Word64]
 }


macho_read_ro_data :: Macho -> Word64 -> Int -> Maybe [Word8]
macho_read_ro_data :: Macho -> Word64 -> Int -> Maybe [Word8]
macho_read_ro_data Macho
m Word64
a Int
si =
  let ds :: IntMap Word8
ds    = Macho -> IntMap Word8
macho_dump Macho
m
      bytes :: [Maybe Word8]
bytes = (Int -> Maybe Word8) -> [Int] -> [Maybe Word8]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
a ->  Int -> IntMap Word8 -> Maybe Word8
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
a IntMap Word8
ds) [Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a..(Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
siInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] in
    case (Maybe Word8 -> Bool) -> [Maybe Word8] -> [Maybe Word8]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Maybe Word8 -> Maybe Word8 -> Bool
forall a. Eq a => a -> a -> Bool
(/=) Maybe Word8
forall a. Maybe a
Nothing) [Maybe Word8]
bytes of
      [] -> Maybe [Word8]
forall a. Maybe a
Nothing
      [Maybe Word8]
bs -> [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just ([Word8] -> Maybe [Word8]) -> [Word8] -> Maybe [Word8]
forall a b. (a -> b) -> a -> b
$ (Maybe Word8 -> Word8) -> [Maybe Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Word8 -> Word8
forall a. HasCallStack => Maybe a -> a
fromJust [Maybe Word8]
bs

macho_read_data :: Macho -> Word64 -> Int -> Maybe [Word8]
macho_read_data :: Macho -> Word64 -> Int -> Maybe [Word8]
macho_read_data Macho
m Word64
a Int
si =
  let ds :: IntMap Word8
ds    = Macho -> IntMap Word8
macho_data Macho
m
      bytes :: [Maybe Word8]
bytes = (Int -> Maybe Word8) -> [Int] -> [Maybe Word8]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
a ->  Int -> IntMap Word8 -> Maybe Word8
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
a IntMap Word8
ds) [Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a..(Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
a)Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
siInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] in
    if Maybe Word8
forall a. Maybe a
Nothing Maybe Word8 -> [Maybe Word8] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe Word8]
bytes then
      Maybe [Word8]
forall a. Maybe a
Nothing
    else
      [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just ([Word8] -> Maybe [Word8]) -> [Word8] -> Maybe [Word8]
forall a b. (a -> b) -> a -> b
$ (Maybe Word8 -> Word8) -> [Maybe Word8] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Maybe Word8 -> Word8
forall a. HasCallStack => Maybe a -> a
fromJust [Maybe Word8]
bytes

macho_get_relocs :: p -> [a]
macho_get_relocs p
_ = []

macho_pp :: p -> [Char]
macho_pp p
_ = [Char]
""


macho_text_section_size :: Macho -> Int
macho_text_section_size = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (Macho -> [Int]) -> Macho -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], [Char], Word64, Word64) -> Int)
-> [([Char], [Char], Word64, Word64)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char], Word64, Word64) -> Int
forall a b a b c. (Integral a, Num b) => (a, b, c, a) -> b
size_of_section ([([Char], [Char], Word64, Word64)] -> [Int])
-> (Macho -> [([Char], [Char], Word64, Word64)]) -> Macho -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Char], [Char], Word64, Word64) -> Bool)
-> [([Char], [Char], Word64, Word64)]
-> [([Char], [Char], Word64, Word64)]
forall a. (a -> Bool) -> [a] -> [a]
filter ([Char], [Char], Word64, Word64) -> Bool
forall c d. ([Char], [Char], c, d) -> Bool
is_text_section ([([Char], [Char], Word64, Word64)]
 -> [([Char], [Char], Word64, Word64)])
-> (Macho -> [([Char], [Char], Word64, Word64)])
-> Macho
-> [([Char], [Char], Word64, Word64)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionsInfo -> [([Char], [Char], Word64, Word64)]
si_sections (SectionsInfo -> [([Char], [Char], Word64, Word64)])
-> (Macho -> SectionsInfo)
-> Macho
-> [([Char], [Char], Word64, Word64)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Macho -> SectionsInfo
macho_sections
 where
  is_text_section :: ([Char], [Char], c, d) -> Bool
is_text_section ([Char]
seg,[Char]
sec,c
_,d
_) = ([Char]
seg,[Char]
sec) ([Char], [Char]) -> [([Char], [Char])] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [([Char]
"__TEXT",[Char]
"__text")]
  size_of_section :: (a, b, c, a) -> b
size_of_section (a
_,b
_,c
_,a
si) = a -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
si




instance BinaryClass Macho
  where
    binary_read_ro_data :: Macho -> Word64 -> Int -> Maybe [Word8]
binary_read_ro_data = Macho -> Word64 -> Int -> Maybe [Word8]
macho_read_ro_data
    binary_read_data :: Macho -> Word64 -> Int -> Maybe [Word8]
binary_read_data = Macho -> Word64 -> Int -> Maybe [Word8]
macho_read_data
    binary_get_sections_info :: Macho -> SectionsInfo
binary_get_sections_info = Macho -> SectionsInfo
macho_sections
    binary_get_symbols :: Macho -> SymbolTable
binary_get_symbols = IntMap Symbol -> SymbolTable
SymbolTable (IntMap Symbol -> SymbolTable)
-> (Macho -> IntMap Symbol) -> Macho -> SymbolTable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Macho -> IntMap Symbol
macho_symbols
    binary_get_relocations :: Macho -> Set Relocation
binary_get_relocations = \Macho
_ -> Set Relocation
forall a. Set a
S.empty
    binary_pp :: Macho -> [Char]
binary_pp = Macho -> [Char]
forall p. p -> [Char]
macho_pp
    binary_entry :: Macho -> Word64
binary_entry = [Word64] -> Word64
forall a. [a] -> a
head ([Word64] -> Word64) -> (Macho -> [Word64]) -> Macho -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Macho -> [Word64]
macho_entry
    binary_text_section_size :: Macho -> Int
binary_text_section_size = Macho -> Int
macho_text_section_size

-- | Read in all files needed to read in MACHO binary executable: data, ro_data, symbols, sections, and entries.
macho_read_file :: [Char] -> [Char] -> IO Macho
macho_read_file [Char]
dirname [Char]
name = do
  IntMap Word8
dat  <- [Char] -> [Char] -> IO (IntMap Word8)
read_data [Char]
dirname [Char]
name
  IntMap Word8
dump <- [Char] -> [Char] -> IO (IntMap Word8)
read_dump [Char]
dirname [Char]
name
  IntMap Symbol
syms <- [Char] -> [Char] -> IO (IntMap Symbol)
read_syms [Char]
dirname [Char]
name
  SectionsInfo
secs <- [Char] -> [Char] -> IO SectionsInfo
read_sections [Char]
dirname [Char]
name
  [Word64]
ents <- [Char] -> [Char] -> IO [Word64]
read_entries [Char]
dirname [Char]
name

  Macho -> IO Macho
forall (m :: * -> *) a. Monad m => a -> m a
return (Macho -> IO Macho) -> Macho -> IO Macho
forall a b. (a -> b) -> a -> b
$ IntMap Word8
-> IntMap Word8
-> IntMap Symbol
-> SectionsInfo
-> [Word64]
-> Macho
Macho IntMap Word8
dat IntMap Word8
dump IntMap Symbol
syms SectionsInfo
secs [Word64]
ents


read_dump :: String -> String -> IO (IM.IntMap Word8)
read_dump :: [Char] -> [Char] -> IO (IntMap Word8)
read_dump [Char]
dirname [Char]
name = do
  let fname :: [Char]
fname = [Char]
dirname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".dump"
  [Char] -> IO (IntMap Word8)
parse [Char]
fname
 where
  parse :: [Char] -> IO (IntMap Word8)
parse [Char]
fname = do
    Either ParseError (IntMap Word8)
ret0 <- [Char] -> IO (Either ParseError (IntMap Word8))
parse_dump ([Char] -> IO (Either ParseError (IntMap Word8)))
-> [Char] -> IO (Either ParseError (IntMap Word8))
forall a b. (a -> b) -> a -> b
$! [Char]
fname
    case Either ParseError (IntMap Word8)
ret0 of
      Left ParseError
err -> [Char] -> IO (IntMap Word8)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (IntMap Word8)) -> [Char] -> IO (IntMap Word8)
forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err
      Right IntMap Word8
dump -> IntMap Word8 -> IO (IntMap Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap Word8
dump

read_data :: String -> String -> IO (IM.IntMap Word8)
read_data :: [Char] -> [Char] -> IO (IntMap Word8)
read_data [Char]
dirname [Char]
name = do
  let fname :: [Char]
fname = [Char]
dirname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".data"
  [Char] -> IO (IntMap Word8)
parse [Char]
fname
 where
  parse :: [Char] -> IO (IntMap Word8)
parse [Char]
fname = do
    Either ParseError (IntMap Word8)
ret0 <- [Char] -> IO (Either ParseError (IntMap Word8))
parse_dump ([Char] -> IO (Either ParseError (IntMap Word8)))
-> [Char] -> IO (Either ParseError (IntMap Word8))
forall a b. (a -> b) -> a -> b
$! [Char]
fname
    case Either ParseError (IntMap Word8)
ret0 of
      Left ParseError
err -> [Char] -> IO (IntMap Word8)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (IntMap Word8)) -> [Char] -> IO (IntMap Word8)
forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err
      Right IntMap Word8
dump -> IntMap Word8 -> IO (IntMap Word8)
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap Word8
dump

read_syms :: String -> String -> IO (IM.IntMap Symbol)
read_syms :: [Char] -> [Char] -> IO (IntMap Symbol)
read_syms [Char]
dirname [Char]
name = do
  let fname :: [Char]
fname = [Char]
dirname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".symbols"
  [Char] -> IO (IntMap Symbol)
parse [Char]
fname
 where
  parse :: [Char] -> IO (IntMap Symbol)
parse [Char]
fname = do
    Either ParseError (IntMap Symbol)
ret0 <- [Char] -> IO (Either ParseError (IntMap Symbol))
parse_symbols ([Char] -> IO (Either ParseError (IntMap Symbol)))
-> [Char] -> IO (Either ParseError (IntMap Symbol))
forall a b. (a -> b) -> a -> b
$! [Char]
fname
    case Either ParseError (IntMap Symbol)
ret0 of
      Left ParseError
err -> [Char] -> IO (IntMap Symbol)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (IntMap Symbol)) -> [Char] -> IO (IntMap Symbol)
forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err
      Right IntMap Symbol
syms -> IntMap Symbol -> IO (IntMap Symbol)
forall (m :: * -> *) a. Monad m => a -> m a
return IntMap Symbol
syms


read_sections :: String -> String -> IO (SectionsInfo)
read_sections :: [Char] -> [Char] -> IO SectionsInfo
read_sections [Char]
dirname [Char]
name = do
  let fname :: [Char]
fname = [Char]
dirname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".sections"
  [Char] -> IO SectionsInfo
parse [Char]
fname
 where
  parse :: [Char] -> IO SectionsInfo
parse [Char]
fname = do
    Either ParseError SectionsInfo
ret0 <- [Char] -> IO (Either ParseError SectionsInfo)
parse_sections ([Char] -> IO (Either ParseError SectionsInfo))
-> [Char] -> IO (Either ParseError SectionsInfo)
forall a b. (a -> b) -> a -> b
$! [Char]
fname
    case Either ParseError SectionsInfo
ret0 of
      Left ParseError
err -> [Char] -> IO SectionsInfo
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO SectionsInfo) -> [Char] -> IO SectionsInfo
forall a b. (a -> b) -> a -> b
$ ParseError -> [Char]
forall a. Show a => a -> [Char]
show ParseError
err
      Right SectionsInfo
sections -> SectionsInfo -> IO SectionsInfo
forall (m :: * -> *) a. Monad m => a -> m a
return SectionsInfo
sections

read_entries :: String -> String -> IO [Word64]
read_entries :: [Char] -> [Char] -> IO [Word64]
read_entries [Char]
dirname [Char]
name = do
  let fname :: [Char]
fname = [Char]
dirname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
name [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
".entry"
  [Char] -> IO [Word64]
parse [Char]
fname
 where
  parse :: [Char] -> IO [Word64]
parse [Char]
fname = do
    [Char]
ls <- [Char] -> IO [Char]
readFile [Char]
fname
    [Word64] -> IO [Word64]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Word64] -> IO [Word64]) -> [Word64] -> IO [Word64]
forall a b. (a -> b) -> a -> b
$ ([Char] -> Word64) -> [[Char]] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Word64
read_line ([[Char]] -> [Word64]) -> [[Char]] -> [Word64]
forall a b. (a -> b) -> a -> b
$ [Char] -> [[Char]]
lines [Char]
ls
  read_line :: [Char] -> Word64
read_line = [Char] -> Word64
forall a. (Eq a, Num a) => [Char] -> a
readHex' ([Char] -> Word64) -> ([Char] -> [Char]) -> [Char] -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
tail ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
forall a. [a] -> [a]
tail