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

module Generic.Binary where

import Base


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 (intercalate)

import GHC.Generics
import qualified Data.Serialize as Cereal hiding (get,put)


-- |  Information on the sections in the binary
data SectionsInfo = SectionsInfo {
  SectionsInfo -> [(String, String, Word64, Word64)]
si_sections    :: [(String,String,Word64,Word64)], -- ^ Sections: segment names, section names, addresses and sizes.
  SectionsInfo -> Word64
si_min_address :: Word64,
  SectionsInfo -> Word64
si_max_address :: Word64
 }
 deriving (Int -> SectionsInfo -> ShowS
[SectionsInfo] -> ShowS
SectionsInfo -> String
(Int -> SectionsInfo -> ShowS)
-> (SectionsInfo -> String)
-> ([SectionsInfo] -> ShowS)
-> Show SectionsInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SectionsInfo] -> ShowS
$cshowList :: [SectionsInfo] -> ShowS
show :: SectionsInfo -> String
$cshow :: SectionsInfo -> String
showsPrec :: Int -> SectionsInfo -> ShowS
$cshowsPrec :: Int -> SectionsInfo -> ShowS
Show,(forall x. SectionsInfo -> Rep SectionsInfo x)
-> (forall x. Rep SectionsInfo x -> SectionsInfo)
-> Generic SectionsInfo
forall x. Rep SectionsInfo x -> SectionsInfo
forall x. SectionsInfo -> Rep SectionsInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SectionsInfo x -> SectionsInfo
$cfrom :: forall x. SectionsInfo -> Rep SectionsInfo x
Generic,SectionsInfo -> SectionsInfo -> Bool
(SectionsInfo -> SectionsInfo -> Bool)
-> (SectionsInfo -> SectionsInfo -> Bool) -> Eq SectionsInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SectionsInfo -> SectionsInfo -> Bool
$c/= :: SectionsInfo -> SectionsInfo -> Bool
== :: SectionsInfo -> SectionsInfo -> Bool
$c== :: SectionsInfo -> SectionsInfo -> Bool
Eq)


-- | An address a0 can have a symbol.
--
-- Relocated_Function:
-- E.g:
-- 		0xcfe0 --> malloc
-- Means that reading 8 bytes from address 0xcfe0 procudes a pointer to malloc.
-- Thus an instruction: "CALL qword ptr [0xcfe0]" can be seen as "CALL malloc".
--
-- Relocated_Object:
-- E.g.:
--    0xd0a8 --> stdout
-- Means that "mov rdi,QWORD PTR [0xd0a8]" can be seen as "mov rdi, QWORD PTR [stdout]"
--
-- Relocated_Address:
-- E.g.:
--    0xaaa -> 0xbbbb
-- Means that reading 8 bytes from address 0xaaaa produces the value 0xbbbb
data Symbol = 
    Relocated_Function String -- ^ Address a0 is a pointer to memory storing the entry of an external function
  | Relocated_Label    String -- ^ Address a0 can be replaced by the string, e.g., "stdout" or "optind"
  | Internal_Label     String -- ^ Address a0 can be replaced by the string.
  deriving ((forall x. Symbol -> Rep Symbol x)
-> (forall x. Rep Symbol x -> Symbol) -> Generic Symbol
forall x. Rep Symbol x -> Symbol
forall x. Symbol -> Rep Symbol x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Symbol x -> Symbol
$cfrom :: forall x. Symbol -> Rep Symbol x
Generic,Symbol -> Symbol -> Bool
(Symbol -> Symbol -> Bool)
-> (Symbol -> Symbol -> Bool) -> Eq Symbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Symbol -> Symbol -> Bool
$c/= :: Symbol -> Symbol -> Bool
== :: Symbol -> Symbol -> Bool
$c== :: Symbol -> Symbol -> Bool
Eq,Int -> Symbol -> ShowS
[Symbol] -> ShowS
Symbol -> String
(Int -> Symbol -> ShowS)
-> (Symbol -> String) -> ([Symbol] -> ShowS) -> Show Symbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Symbol] -> ShowS
$cshowList :: [Symbol] -> ShowS
show :: Symbol -> String
$cshow :: Symbol -> String
showsPrec :: Int -> Symbol -> ShowS
$cshowsPrec :: Int -> Symbol -> ShowS
Show)

data SymbolTable = SymbolTable (IM.IntMap Symbol)
  deriving ((forall x. SymbolTable -> Rep SymbolTable x)
-> (forall x. Rep SymbolTable x -> SymbolTable)
-> Generic SymbolTable
forall x. Rep SymbolTable x -> SymbolTable
forall x. SymbolTable -> Rep SymbolTable x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SymbolTable x -> SymbolTable
$cfrom :: forall x. SymbolTable -> Rep SymbolTable x
Generic,SymbolTable -> SymbolTable -> Bool
(SymbolTable -> SymbolTable -> Bool)
-> (SymbolTable -> SymbolTable -> Bool) -> Eq SymbolTable
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymbolTable -> SymbolTable -> Bool
$c/= :: SymbolTable -> SymbolTable -> Bool
== :: SymbolTable -> SymbolTable -> Bool
$c== :: SymbolTable -> SymbolTable -> Bool
Eq)

instance Show SymbolTable where
  show :: SymbolTable -> String
show (SymbolTable IntMap Symbol
tbl) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((Int, Symbol) -> String) -> [(Int, Symbol)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Symbol) -> String
forall a. (Integral a, Show a) => (a, Symbol) -> String
show_entry ([(Int, Symbol)] -> [String]) -> [(Int, Symbol)] -> [String]
forall a b. (a -> b) -> a -> b
$ IntMap Symbol -> [(Int, Symbol)]
forall a. IntMap a -> [(Int, a)]
IM.assocs IntMap Symbol
tbl
   where
    show_entry :: (a, Symbol) -> String
show_entry (a
a0,Relocated_Function String
f) = a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
a0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (external function)"
    show_entry (a
a0,Relocated_Label String
l)    = a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
a0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
l String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (external object)"
    show_entry (a
a0,Internal_Label String
f)     = a -> String
forall a. (Integral a, Show a) => a -> String
showHex a
a0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (internal)"


-- | Is the symbol an internal label?
is_internal_symbol :: Symbol -> Bool
is_internal_symbol (Internal_Label String
_) = Bool
True
is_internal_symbol Symbol
_ = Bool
False

-- | Is the symbol an external label?
is_external_symbol :: Symbol -> Bool
is_external_symbol (Relocated_Function String
_) = Bool
True
is_external_symbol (Relocated_Label String
_) = Bool
True
is_external_symbol Symbol
_ = Bool
False

-- | Returns the name from the symbol
symbol_to_name :: Symbol -> Maybe String
symbol_to_name (Relocated_Function String
str) = String -> Maybe String
forall a. a -> Maybe a
Just String
str
symbol_to_name (Relocated_Label String
str) = String -> Maybe String
forall a. a -> Maybe a
Just String
str
symbol_to_name (Internal_Label String
str) = String -> Maybe String
forall a. a -> Maybe a
Just String
str


data Relocation = 
  Relocation Word64 Word64 -- ^ 8: At address a0, address a1 has been written, i.e., qword ptr[a0] == a1
  deriving ((forall x. Relocation -> Rep Relocation x)
-> (forall x. Rep Relocation x -> Relocation) -> Generic Relocation
forall x. Rep Relocation x -> Relocation
forall x. Relocation -> Rep Relocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Relocation x -> Relocation
$cfrom :: forall x. Relocation -> Rep Relocation x
Generic,Relocation -> Relocation -> Bool
(Relocation -> Relocation -> Bool)
-> (Relocation -> Relocation -> Bool) -> Eq Relocation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relocation -> Relocation -> Bool
$c/= :: Relocation -> Relocation -> Bool
== :: Relocation -> Relocation -> Bool
$c== :: Relocation -> Relocation -> Bool
Eq,Eq Relocation
Eq Relocation
-> (Relocation -> Relocation -> Ordering)
-> (Relocation -> Relocation -> Bool)
-> (Relocation -> Relocation -> Bool)
-> (Relocation -> Relocation -> Bool)
-> (Relocation -> Relocation -> Bool)
-> (Relocation -> Relocation -> Relocation)
-> (Relocation -> Relocation -> Relocation)
-> Ord Relocation
Relocation -> Relocation -> Bool
Relocation -> Relocation -> Ordering
Relocation -> Relocation -> Relocation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Relocation -> Relocation -> Relocation
$cmin :: Relocation -> Relocation -> Relocation
max :: Relocation -> Relocation -> Relocation
$cmax :: Relocation -> Relocation -> Relocation
>= :: Relocation -> Relocation -> Bool
$c>= :: Relocation -> Relocation -> Bool
> :: Relocation -> Relocation -> Bool
$c> :: Relocation -> Relocation -> Bool
<= :: Relocation -> Relocation -> Bool
$c<= :: Relocation -> Relocation -> Bool
< :: Relocation -> Relocation -> Bool
$c< :: Relocation -> Relocation -> Bool
compare :: Relocation -> Relocation -> Ordering
$ccompare :: Relocation -> Relocation -> Ordering
$cp1Ord :: Eq Relocation
Ord)

instance Show Relocation where
  show :: Relocation -> String
show (Relocation Word64
a0 Word64
a1)  = Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
a0 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. (Integral a, Show a) => a -> String
showHex Word64
a1



class BinaryClass a where
  binary_read_ro_data :: a -> Word64 -> Int -> Maybe [Word8]
  binary_read_data :: a -> Word64 -> Int -> Maybe [Word8]
  binary_get_sections_info :: a -> SectionsInfo
  binary_get_symbols :: a -> SymbolTable
  binary_get_relocations :: a -> S.Set Relocation
  binary_pp :: a -> String
  binary_entry :: a -> Word64
  binary_text_section_size :: a -> Int



data Binary = forall b . BinaryClass b => Binary b


instance BinaryClass Binary where
  binary_read_ro_data :: Binary -> Word64 -> Int -> Maybe [Word8]
binary_read_ro_data (Binary b
b) = b -> Word64 -> Int -> Maybe [Word8]
forall a. BinaryClass a => a -> Word64 -> Int -> Maybe [Word8]
binary_read_ro_data b
b
  binary_read_data :: Binary -> Word64 -> Int -> Maybe [Word8]
binary_read_data (Binary b
b) = b -> Word64 -> Int -> Maybe [Word8]
forall a. BinaryClass a => a -> Word64 -> Int -> Maybe [Word8]
binary_read_data b
b
  binary_get_sections_info :: Binary -> SectionsInfo
binary_get_sections_info (Binary b
b) = b -> SectionsInfo
forall a. BinaryClass a => a -> SectionsInfo
binary_get_sections_info b
b
  binary_get_symbols :: Binary -> SymbolTable
binary_get_symbols (Binary b
b) = b -> SymbolTable
forall a. BinaryClass a => a -> SymbolTable
binary_get_symbols b
b
  binary_get_relocations :: Binary -> Set Relocation
binary_get_relocations (Binary b
b) = b -> Set Relocation
forall a. BinaryClass a => a -> Set Relocation
binary_get_relocations b
b
  binary_pp :: Binary -> String
binary_pp (Binary b
b) = b -> String
forall a. BinaryClass a => a -> String
binary_pp b
b
  binary_entry :: Binary -> Word64
binary_entry (Binary b
b) = b -> Word64
forall a. BinaryClass a => a -> Word64
binary_entry b
b
  binary_text_section_size :: Binary -> Int
binary_text_section_size (Binary b
b) = b -> Int
forall a. BinaryClass a => a -> Int
binary_text_section_size b
b