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

module Binary.Macho (macho_read_file) where

import Base

import Binary.Generic
import Data.Symbol

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 -> String
macho_dir_name :: String,
  Macho -> String
macho_file_name :: String
 }


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 a. Eq a => a -> [a] -> 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 -> String
macho_pp p
_ = String
""


macho_text_section_size :: Macho -> Int
macho_text_section_size = [Int] -> Int
forall a. Num a => [a] -> a
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
. ((String, String, Word64, Word64, Word64) -> Int)
-> [(String, String, Word64, Word64, Word64)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String, String, Word64, Word64, Word64) -> Int
forall {d} {b} {a} {b} {c} {e}.
(Integral d, Num b) =>
(a, b, c, d, e) -> b
size_of_section ([(String, String, Word64, Word64, Word64)] -> [Int])
-> (Macho -> [(String, String, Word64, Word64, Word64)])
-> Macho
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String, Word64, Word64, Word64) -> Bool)
-> [(String, String, Word64, Word64, Word64)]
-> [(String, String, Word64, Word64, Word64)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, String, Word64, Word64, Word64) -> Bool
forall {c} {d} {e}. (String, String, c, d, e) -> Bool
is_text_section ([(String, String, Word64, Word64, Word64)]
 -> [(String, String, Word64, Word64, Word64)])
-> (Macho -> [(String, String, Word64, Word64, Word64)])
-> Macho
-> [(String, String, Word64, Word64, Word64)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SectionsInfo -> [(String, String, Word64, Word64, Word64)]
si_sections (SectionsInfo -> [(String, String, Word64, Word64, Word64)])
-> (Macho -> SectionsInfo)
-> Macho
-> [(String, String, Word64, Word64, Word64)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Macho -> SectionsInfo
macho_sections
 where
  is_text_section :: (String, String, c, d, e) -> Bool
is_text_section (String
seg,String
sec,c
_,d
_,e
_) = (String
seg,String
sec) (String, String) -> [(String, String)] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(String
"__TEXT",String
"__text")]
  size_of_section :: (a, b, c, d, e) -> b
size_of_section (a
_,b
_,c
_,d
si,e
_) = d -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (d -> b) -> d -> b
forall a b. (a -> b) -> a -> b
$ d
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 Macho
b = IntMap Symbol -> Set String -> SymbolTable
SymbolTable (Macho -> IntMap Symbol
macho_symbols Macho
b) Set String
forall a. Set a
S.empty
    binary_get_relocations :: Macho -> Set Relocation
binary_get_relocations = \Macho
_ -> Set Relocation
forall a. Set a
S.empty
    binary_pp :: Macho -> String
binary_pp = Macho -> String
forall {p}. p -> String
macho_pp
    binary_entry :: Macho -> Word64
binary_entry = [Word64] -> Word64
forall a. HasCallStack => [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
    binary_dir_name :: Macho -> String
binary_dir_name = Macho -> String
macho_dir_name
    binary_file_name :: Macho -> String
binary_file_name = Macho -> String
macho_file_name

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

  Macho -> IO Macho
forall a. a -> IO a
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]
-> String
-> String
-> Macho
Macho IntMap Word8
dat IntMap Word8
dump IntMap Symbol
syms SectionsInfo
secs [Word64]
ents String
dirname String
name


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

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

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


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

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