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

module Binary.Elf where

import Base

import Binary.Generic

import Data.Elf
import Data.Symbol

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 qualified Data.ByteString.Lazy as LBS
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

import Debug.Trace

deriving instance Generic ElfMachine
deriving instance Generic ElfSegmentType
deriving instance Generic ElfSegmentFlag
deriving instance Generic ElfSegment
deriving instance Generic ElfType
deriving instance Generic ElfOSABI
deriving instance Generic ElfClass
deriving instance Generic ElfData
deriving instance Generic ElfSectionFlags
deriving instance Generic ElfSectionType
deriving instance Generic ElfSection
deriving instance Generic Elf
deriving instance Generic NamedElf

instance Cereal.Serialize ElfMachine
instance Cereal.Serialize ElfSegmentType
instance Cereal.Serialize ElfSegmentFlag
instance Cereal.Serialize ElfSegment
instance Cereal.Serialize ElfType
instance Cereal.Serialize ElfOSABI
instance Cereal.Serialize ElfClass
instance Cereal.Serialize ElfData
instance Cereal.Serialize ElfSectionFlags
instance Cereal.Serialize ElfSectionType
instance Cereal.Serialize ElfSection
instance Cereal.Serialize Elf
instance Cereal.Serialize NamedElf




data NamedElf = NamedElf {
  NamedElf -> Elf
elf :: !Elf,
  NamedElf -> String
elf_dir_name :: !String,
  NamedElf -> String
elf_file_name :: !String,
  NamedElf -> SectionsInfo
elf_sections_info :: !SectionsInfo,
  NamedElf -> SymbolTable
elf_symbol_table :: !SymbolTable,
  NamedElf -> Set Relocation
elf_relocs :: !(S.Set Relocation)
 }



-- | Overview of sections with read only data.
sections_ro_data :: [(String, String)]
sections_ro_data = [
   (String
"",String
".text"),
   (String
"",String
".init"),
   (String
"",String
".fini"),
   (String
"",String
".rodata"),
   (String
"",String
".plt"),
   (String
"",String
".plt.got"),
   (String
"",String
".plt.sec"),
   (String
"",String
".data.rel.ro"),
   (String
"",String
".init_array"),
   (String
"",String
".fini_array")
 ]

sections_data :: [(String, String)]
sections_data = [
   (String
"",String
".data")
 ]

sections_bss :: [(String, String)]
sections_bss = [
   (String
"",String
".bss")
 ]


sections_text :: [(String, String)]
sections_text = [
   (String
"",String
".text")
 ]



isRelevantElfSection :: ElfSection -> Bool
isRelevantElfSection ElfSection
section = (String
"",ElfSection -> String
elfSectionName ElfSection
section) (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, String)]
sections_ro_data [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
sections_data [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. [a] -> [a] -> [a]
++ [(String, String)]
sections_bss

isAllocated :: ElfSection -> Bool
isAllocated ElfSection
section = ElfSectionFlags
SHF_ALLOC ElfSectionFlags -> [ElfSectionFlags] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ElfSection -> [ElfSectionFlags]
elfSectionFlags ElfSection
section



-- reading bytes from sections. 
read_bytes_section :: Word64 -> Int -> ElfSection -> [Word8]
read_bytes_section Word64
a Int
si ElfSection
section = ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
si (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- ElfSection -> Word64
elfSectionAddr ElfSection
section) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ElfSection -> ByteString
elfSectionData ElfSection
section

contains_address :: Word64 -> ElfSection -> Bool
contains_address Word64
a ElfSection
section = 
  let a0 :: Word64
a0  = ElfSection -> Word64
elfSectionAddr ElfSection
section
      si0 :: Word64
si0 = ElfSection -> Word64
elfSectionSize ElfSection
section in
    Word64
a0 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
a Bool -> Bool -> Bool
&& Word64
a Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
a0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
si0


elf_read_bytestring :: Elf -> Word64 -> Int -> Maybe LBS.ByteString
elf_read_bytestring :: Elf -> Word64 -> Int -> Maybe ByteString
elf_read_bytestring Elf
elf Word64
a Int
si =
  case (ElfSection -> Bool) -> [ElfSection] -> Maybe ElfSection
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (Word64 -> ElfSection -> Bool
contains_address Word64
a) ([ElfSection] -> Maybe ElfSection)
-> [ElfSection] -> Maybe ElfSection
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfSection]
elfSections Elf
elf of
    Maybe ElfSection
Nothing -> Maybe ByteString
forall a. Maybe a
Nothing
    Just ElfSection
section -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
si (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Word64
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- ElfSection -> Word64
elfSectionAddr ElfSection
section) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ElfSection -> ByteString
elfSectionData ElfSection
section
 where
  isRelevant :: ElfSection -> Bool
isRelevant ElfSection
section
    |  (String
"",ElfSection -> String
elfSectionName ElfSection
section) (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, String)]
sections_ro_data = Bool
True
    | Bool
otherwise = Bool
False




elf_read_ro_data :: Elf -> Word64 -> Int -> Maybe [Word8]
elf_read_ro_data :: Elf -> Word64 -> Int -> Maybe [Word8]
elf_read_ro_data Elf
elf Word64
a Int
si =
  case (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter ElfSection -> Bool
isRelevant ([ElfSection] -> [ElfSection]) -> [ElfSection] -> [ElfSection]
forall a b. (a -> b) -> a -> b
$ (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word64 -> ElfSection -> Bool
contains_address Word64
a) ([ElfSection] -> [ElfSection]) -> [ElfSection] -> [ElfSection]
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfSection]
elfSections Elf
elf of
    [] -> Maybe [Word8]
forall a. Maybe a
Nothing
    [ElfSection
section] -> [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just ([Word8] -> Maybe [Word8]) -> [Word8] -> Maybe [Word8]
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> ElfSection -> [Word8]
read_bytes_section Word64
a Int
si ElfSection
section
 where
  isRelevant :: ElfSection -> Bool
isRelevant ElfSection
section
    |  (String
"",ElfSection -> String
elfSectionName ElfSection
section) (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, String)]
sections_ro_data = Bool
True
    | Bool
otherwise = Bool
False

elf_read_data :: Elf -> Word64 -> Int -> Maybe [Word8]
elf_read_data :: Elf -> Word64 -> Int -> Maybe [Word8]
elf_read_data Elf
elf Word64
a Int
si =
  case (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter ElfSection -> Bool
isBss ([ElfSection] -> [ElfSection]) -> [ElfSection] -> [ElfSection]
forall a b. (a -> b) -> a -> b
$ (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word64 -> ElfSection -> Bool
contains_address Word64
a) ([ElfSection] -> [ElfSection]) -> [ElfSection] -> [ElfSection]
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfSection]
elfSections Elf
elf of
    [ElfSection
section] -> [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just ([Word8] -> Maybe [Word8]) -> [Word8] -> Maybe [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
si Word8
0
    [] -> Maybe [Word8]
try_read_data
 where 
  try_read_data :: Maybe [Word8]
try_read_data =
    case (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter ElfSection -> Bool
isData ([ElfSection] -> [ElfSection]) -> [ElfSection] -> [ElfSection]
forall a b. (a -> b) -> a -> b
$ (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word64 -> ElfSection -> Bool
contains_address Word64
a) ([ElfSection] -> [ElfSection]) -> [ElfSection] -> [ElfSection]
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfSection]
elfSections Elf
elf of
      [] -> Maybe [Word8]
forall a. Maybe a
Nothing
      [ElfSection
section] -> [Word8] -> Maybe [Word8]
forall a. a -> Maybe a
Just ([Word8] -> Maybe [Word8]) -> [Word8] -> Maybe [Word8]
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> ElfSection -> [Word8]
read_bytes_section Word64
a Int
si ElfSection
section

  isData :: ElfSection -> Bool
isData ElfSection
section 
    | (String
"",ElfSection -> String
elfSectionName ElfSection
section) (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, String)]
sections_data = Bool
True
    | Bool
otherwise = Bool
False
  isBss :: ElfSection -> Bool
isBss ElfSection
section 
    | (String
"",ElfSection -> String
elfSectionName ElfSection
section) (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, String)]
sections_bss = Bool
True
    | Bool
otherwise = Bool
False



elf_get_relocs :: Elf -> Set Relocation
elf_get_relocs Elf
elf = [Relocation] -> Set Relocation
forall a. Ord a => [a] -> Set a
S.fromList ([Relocation] -> Set Relocation) -> [Relocation] -> Set Relocation
forall a b. (a -> b) -> a -> b
$ [Relocation]
mk_relocs
 where
  -- go through all relocations
  mk_relocs :: [Relocation]
mk_relocs = (ElfRelocationSection -> [Relocation])
-> [ElfRelocationSection] -> [Relocation]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ElfRelocationSection -> [Relocation]
mk_reloc ([ElfRelocationSection] -> [Relocation])
-> [ElfRelocationSection] -> [Relocation]
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfRelocationSection]
parseRelocations Elf
elf
  
  mk_reloc :: ElfRelocationSection -> [Relocation]
mk_reloc ElfRelocationSection
sec = (ElfRel -> [Relocation]) -> [ElfRel] -> [Relocation]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ElfRelocationSection -> ElfRel -> [Relocation]
forall {p}. p -> ElfRel -> [Relocation]
try_mk_reloc ElfRelocationSection
sec) (ElfRelocationSection -> [ElfRel]
elfRelSectRelocations ElfRelocationSection
sec)

  try_mk_reloc :: p -> ElfRel -> [Relocation]
try_mk_reloc p
sec ElfRel
reloc
   | ElfRel -> Word8
elfRelType ElfRel
reloc Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
8 =
     -- R_X86_64_RELATIVE
     -- The SymAddend provides the relocation address
     case ElfRel -> Maybe Int64
elfRelSymAddend ElfRel
reloc of
       Maybe Int64
Nothing     -> [Word64 -> Word64 -> Relocation
Relocation (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelOffset ElfRel
reloc) Word64
0] -- TODO implicit addend?
       Just Int64
addend -> [Word64 -> Word64 -> Relocation
Relocation (Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelOffset ElfRel
reloc) (Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word64) -> Int64 -> Word64
forall a b. (a -> b) -> a -> b
$ Int64
addend)]
   | Bool
otherwise = []


elf_get_symbol_table :: Elf -> SymbolTable
elf_get_symbol_table Elf
elf = IntMap Symbol -> Set String -> SymbolTable
SymbolTable IntMap Symbol
mk_symbols Set String
mk_globals
 where
  mk_symbols :: IntMap Symbol
mk_symbols = [(Int, Symbol)] -> IntMap Symbol
forall a. [(Int, a)] -> IntMap a
IM.fromList ([(Int, Symbol)] -> IntMap Symbol)
-> [(Int, Symbol)] -> IntMap Symbol
forall a b. (a -> b) -> a -> b
$ ((Int, Symbol) -> Bool) -> [(Int, Symbol)] -> [(Int, Symbol)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(/=) String
"" (String -> Bool)
-> ((Int, Symbol) -> String) -> (Int, Symbol) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Symbol -> String
symbol_to_name (Symbol -> String)
-> ((Int, Symbol) -> Symbol) -> (Int, Symbol) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Symbol) -> Symbol
forall a b. (a, b) -> b
snd) ([(Int, Symbol)] -> [(Int, Symbol)])
-> [(Int, Symbol)] -> [(Int, Symbol)]
forall a b. (a -> b) -> a -> b
$ [(Int, Symbol)]
symbols_from_ELF_symbol_tables [(Int, Symbol)] -> [(Int, Symbol)] -> [(Int, Symbol)]
forall a. [a] -> [a] -> [a]
++ [(Int, Symbol)]
symbols_from_relocations

  mk_globals :: Set String
mk_globals = [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String) -> [String] -> Set String
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(/=) String
"") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (ElfSymbolTableEntry -> String)
-> [ElfSymbolTableEntry] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Word32, Maybe ByteString) -> String
forall {a}. (a, Maybe ByteString) -> String
get_string_from_steName ((Word32, Maybe ByteString) -> String)
-> (ElfSymbolTableEntry -> (Word32, Maybe ByteString))
-> ElfSymbolTableEntry
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfSymbolTableEntry -> (Word32, Maybe ByteString)
steName) ([ElfSymbolTableEntry] -> [String])
-> [ElfSymbolTableEntry] -> [String]
forall a b. (a -> b) -> a -> b
$ (ElfSymbolTableEntry -> Bool)
-> [ElfSymbolTableEntry] -> [ElfSymbolTableEntry]
forall a. (a -> Bool) -> [a] -> [a]
filter ElfSymbolTableEntry -> Bool
isGlobalAndInternallyDefined ([ElfSymbolTableEntry] -> [ElfSymbolTableEntry])
-> [ElfSymbolTableEntry] -> [ElfSymbolTableEntry]
forall a b. (a -> b) -> a -> b
$ [[ElfSymbolTableEntry]] -> [ElfSymbolTableEntry]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ElfSymbolTableEntry]] -> [ElfSymbolTableEntry])
-> [[ElfSymbolTableEntry]] -> [ElfSymbolTableEntry]
forall a b. (a -> b) -> a -> b
$ Elf -> [[ElfSymbolTableEntry]]
parseSymbolTables Elf
elf

  isGlobalAndInternallyDefined :: ElfSymbolTableEntry -> Bool
isGlobalAndInternallyDefined ElfSymbolTableEntry
sym_entry = ElfSymbolTableEntry -> ElfSectionIndex
steIndex ElfSymbolTableEntry
sym_entry ElfSectionIndex -> ElfSectionIndex -> Bool
forall a. Eq a => a -> a -> Bool
/= ElfSectionIndex
SHNUndef Bool -> Bool -> Bool
&& ElfSymbolTableEntry -> ElfSymbolBinding
steBind ElfSymbolTableEntry
sym_entry ElfSymbolBinding -> ElfSymbolBinding -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSymbolBinding
STBGlobal




  -- go through all relocations
  symbols_from_relocations :: [(Int, Symbol)]
symbols_from_relocations = (ElfRelocationSection -> [(Int, Symbol)])
-> [ElfRelocationSection] -> [(Int, Symbol)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ElfRelocationSection -> [(Int, Symbol)]
forall {a}. Num a => ElfRelocationSection -> [(a, Symbol)]
mk_symbol_table_for_reloc_section ([ElfRelocationSection] -> [(Int, Symbol)])
-> [ElfRelocationSection] -> [(Int, Symbol)]
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfRelocationSection]
parseRelocations Elf
elf
  
  mk_symbol_table_for_reloc_section :: ElfRelocationSection -> [(a, Symbol)]
mk_symbol_table_for_reloc_section ElfRelocationSection
sec = (ElfRel -> [(a, Symbol)]) -> [ElfRel] -> [(a, Symbol)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (ElfRelocationSection -> ElfRel -> [(a, Symbol)]
forall {a}.
Num a =>
ElfRelocationSection -> ElfRel -> [(a, Symbol)]
try_mk_symbol_entry ElfRelocationSection
sec) (ElfRelocationSection -> [ElfRel]
elfRelSectRelocations ElfRelocationSection
sec)

  try_mk_symbol_entry :: ElfRelocationSection -> ElfRel -> [(a, Symbol)]
try_mk_symbol_entry ElfRelocationSection
sec ElfRel
reloc
    | ElfRel -> Word8
elfRelType ElfRel
reloc Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
7 =
      -- R_X86_64_JUMP_SLOT
      -- the RelSymbol provides an index into a lookup table that contains the name of the symbol
      [(Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelOffset ElfRel
reloc, ((String -> Bool -> Symbol) -> (String, Bool) -> Symbol
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Bool -> Symbol
PointerToLabel) ((String, Bool) -> Symbol) -> (String, Bool) -> Symbol
forall a b. (a -> b) -> a -> b
$ ElfRelocationSection -> ElfRel -> (String, Bool)
get_name_and_inex_from_reloc ElfRelocationSection
sec ElfRel
reloc)]
    | ElfRel -> Word8
elfRelType ElfRel
reloc Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
6 =
      -- R_X86_64_GLOB_DAT, objects
      -- the RelSymbol provides an index into a lookup table that contains the name of the symbol
      let symbol_table_entry :: ElfSymbolTableEntry
symbol_table_entry      = (ElfRelocationSection -> [ElfSymbolTableEntry]
elfRelSectSymbolTable ElfRelocationSection
sec) [ElfSymbolTableEntry] -> Int -> ElfSymbolTableEntry
forall a. HasCallStack => [a] -> Int -> a
!! (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelSymbol ElfRel
reloc)
          name_of_reloc_trgt :: (String, Bool)
name_of_reloc_trgt      = ElfSymbolTableEntry -> (String, Bool)
get_name_and_inex_from_sym_entry (ElfSymbolTableEntry -> (String, Bool))
-> ElfSymbolTableEntry -> (String, Bool)
forall a b. (a -> b) -> a -> b
$ ElfSymbolTableEntry
symbol_table_entry
          symb_type_of_reloc_trgt :: ElfSymbolType
symb_type_of_reloc_trgt = ElfSymbolTableEntry -> ElfSymbolType
steType (ElfSymbolTableEntry -> ElfSymbolType)
-> ElfSymbolTableEntry -> ElfSymbolType
forall a b. (a -> b) -> a -> b
$ ElfSymbolTableEntry
symbol_table_entry
          reloc_address :: a
reloc_address           = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelOffset ElfRel
reloc in
        if ElfSymbolType
symb_type_of_reloc_trgt ElfSymbolType -> [ElfSymbolType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ElfSymbolType
STTObject,ElfSymbolType
STTCommon] then
          let symbol_table_entry :: ElfSymbolTableEntry
symbol_table_entry = (ElfRelocationSection -> [ElfSymbolTableEntry]
elfRelSectSymbolTable ElfRelocationSection
sec) [ElfSymbolTableEntry] -> Int -> ElfSymbolTableEntry
forall a. HasCallStack => [a] -> Int -> a
!! (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelSymbol ElfRel
reloc)
              bind :: ElfSymbolBinding
bind               = ElfSymbolTableEntry -> ElfSymbolBinding
steBind ElfSymbolTableEntry
symbol_table_entry
              value :: Word64
value              = ElfSymbolTableEntry -> Word64
steValue ElfSymbolTableEntry
symbol_table_entry in
            if (ElfRelocationSection -> Bool) -> [ElfRelocationSection] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ElfRelocationSection
sec -> (ElfRel -> Bool) -> [ElfRel] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\ElfRel
reloc -> ElfRel -> Word64
elfRelOffset ElfRel
reloc Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
value) ([ElfRel] -> Bool) -> [ElfRel] -> Bool
forall a b. (a -> b) -> a -> b
$ ElfRelocationSection -> [ElfRel]
elfRelSectRelocations ElfRelocationSection
sec) ([ElfRelocationSection] -> Bool) -> [ElfRelocationSection] -> Bool
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfRelocationSection]
parseRelocations Elf
elf then
              [(a
reloc_address, (String -> Word64 -> Symbol
Relocated_ResolvedObject ((String, Bool) -> String
forall a b. (a, b) -> a
fst (String, Bool)
name_of_reloc_trgt) Word64
value))]
            else
              [(a
reloc_address, ((String -> Bool -> Symbol) -> (String, Bool) -> Symbol
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Bool -> Symbol
PointerToObject) (String, Bool)
name_of_reloc_trgt)]
        else 
          [(a
reloc_address, ((String -> Bool -> Symbol) -> (String, Bool) -> Symbol
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Bool -> Symbol
PointerToLabel) (String, Bool)
name_of_reloc_trgt)]
   | ElfRel -> Word8
elfRelType ElfRel
reloc Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
5 =
      -- R_X86_64_COPY
      -- the RelSymbol provides an index into a lookup table that contains the name of the symbol
      [(Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelOffset ElfRel
reloc, String -> Bool -> Symbol
AddressOfObject ((String, Bool) -> String
forall a b. (a, b) -> a
fst ((String, Bool) -> String) -> (String, Bool) -> String
forall a b. (a -> b) -> a -> b
$ ElfRelocationSection -> ElfRel -> (String, Bool)
get_name_and_inex_from_reloc ElfRelocationSection
sec ElfRel
reloc) Bool
True)]
   | ElfRel -> Word8
elfRelType ElfRel
reloc Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
1 =
      -- R_X86_64_64
      -- the RelSymbol provides an index into a lookup table that contains the name of the symbol
      -- RelSymAddend should be zero
      let symbol_table_entry :: ElfSymbolTableEntry
symbol_table_entry      = (ElfRelocationSection -> [ElfSymbolTableEntry]
elfRelSectSymbolTable ElfRelocationSection
sec) [ElfSymbolTableEntry] -> Int -> ElfSymbolTableEntry
forall a. HasCallStack => [a] -> Int -> a
!! (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelSymbol ElfRel
reloc)
          name_of_reloc_trgt :: (String, Bool)
name_of_reloc_trgt      = ElfSymbolTableEntry -> (String, Bool)
get_name_and_inex_from_sym_entry ElfSymbolTableEntry
symbol_table_entry
          symb_type_of_reloc_trgt :: ElfSymbolType
symb_type_of_reloc_trgt = ElfSymbolTableEntry -> ElfSymbolType
steType (ElfSymbolTableEntry -> ElfSymbolType)
-> ElfSymbolTableEntry -> ElfSymbolType
forall a b. (a -> b) -> a -> b
$ ElfSymbolTableEntry
symbol_table_entry
          reloc_address :: a
reloc_address           = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelOffset ElfRel
reloc in
        if ElfSymbolType
symb_type_of_reloc_trgt ElfSymbolType -> ElfSymbolType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSymbolType
STTFunc then
          [(a
reloc_address, ((String -> Bool -> Symbol) -> (String, Bool) -> Symbol
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> Bool -> Symbol
PointerToLabel) (String, Bool)
name_of_reloc_trgt)]
        else
          String -> [(a, Symbol)]
forall a. HasCallStack => String -> a
error (String -> [(a, Symbol)]) -> String -> [(a, Symbol)]
forall a b. (a -> b) -> a -> b
$ (ElfRel, ElfSymbolTableEntry, ElfSymbolType) -> String
forall a. Show a => a -> String
show (ElfRel
reloc,ElfSymbolTableEntry
symbol_table_entry,ElfSymbolType
symb_type_of_reloc_trgt) -- TODO very likely this is exactly the same as elfRelType reloc == 6
   | Bool
otherwise = []


  -- go through all ELF symbol tables
  -- each symbol table entry that has as type STTObject with binding /= Local is considered external and that is not hidden
  -- its value is the address at which a relocation happens
  symbols_from_ELF_symbol_tables :: [(Int, Symbol)]
symbols_from_ELF_symbol_tables = (ElfSymbolTableEntry -> [(Int, Symbol)])
-> [ElfSymbolTableEntry] -> [(Int, Symbol)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ElfSymbolTableEntry -> [(Int, Symbol)]
forall {a}. Num a => ElfSymbolTableEntry -> [(a, Symbol)]
mk_symbol_entry ([ElfSymbolTableEntry] -> [(Int, Symbol)])
-> [ElfSymbolTableEntry] -> [(Int, Symbol)]
forall a b. (a -> b) -> a -> b
$ [[ElfSymbolTableEntry]] -> [ElfSymbolTableEntry]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ElfSymbolTableEntry]] -> [ElfSymbolTableEntry])
-> [[ElfSymbolTableEntry]] -> [ElfSymbolTableEntry]
forall a b. (a -> b) -> a -> b
$ Elf -> [[ElfSymbolTableEntry]]
parseSymbolTables Elf
elf

  mk_symbol_entry :: ElfSymbolTableEntry -> [(a, Symbol)]
mk_symbol_entry ElfSymbolTableEntry
sym_entry
    -- | is_external_var_symbol_entry sym_entry = [(fromIntegral $ steValue sym_entry, AddressOfLabel (get_string_from_steName $ steName sym_entry) True)]
    | ElfSymbolTableEntry -> Bool
is_internal_symbol_entry ElfSymbolTableEntry
sym_entry     = [(Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ ElfSymbolTableEntry -> Word64
steValue ElfSymbolTableEntry
sym_entry, String -> Bool -> Symbol
AddressOfLabel ((Word32, Maybe ByteString) -> String
forall {a}. (a, Maybe ByteString) -> String
get_string_from_steName ((Word32, Maybe ByteString) -> String)
-> (Word32, Maybe ByteString) -> String
forall a b. (a -> b) -> a -> b
$ ElfSymbolTableEntry -> (Word32, Maybe ByteString)
steName ElfSymbolTableEntry
sym_entry) Bool
False)]
    | Bool
otherwise = []


  -- external_variables = map mk_symbol_entry $ filter is_external_var_symbol_entry $ concat $ parseSymbolTables elf
  is_external_var_symbol_entry :: ElfSymbolTableEntry -> Bool
is_external_var_symbol_entry ElfSymbolTableEntry
sym_entry = ElfSymbolTableEntry -> ElfSymbolType
steType ElfSymbolTableEntry
sym_entry ElfSymbolType -> [ElfSymbolType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ElfSymbolType
STTObject,ElfSymbolType
STTCommon] Bool -> Bool -> Bool
&& ElfSymbolTableEntry -> ElfSymbolBinding
steBind ElfSymbolTableEntry
sym_entry ElfSymbolBinding -> [ElfSymbolBinding] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ElfSymbolBinding
STBGlobal, ElfSymbolBinding
STBWeak] Bool -> Bool -> Bool
&& Bool -> Bool
not (ElfSymbolTableEntry -> Bool
isHiddenSymEntry ElfSymbolTableEntry
sym_entry)
  
  is_internal_symbol_entry :: ElfSymbolTableEntry -> Bool
is_internal_symbol_entry ElfSymbolTableEntry
sym_entry = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or
    [ ElfSymbolTableEntry -> Maybe ElfSection
steEnclosingSection ElfSymbolTableEntry
sym_entry Maybe ElfSection -> Maybe ElfSection -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe ElfSection
forall a. Maybe a
Nothing Bool -> Bool -> Bool
&& ElfSymbolTableEntry -> ElfSymbolType
steType ElfSymbolTableEntry
sym_entry ElfSymbolType -> [ElfSymbolType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ElfSymbolType
STTObject,ElfSymbolType
STTCommon]
    , ElfSymbolTableEntry -> Bool
is_hidden ElfSymbolTableEntry
sym_entry ]


  get_name_and_inex_from_reloc :: ElfRelocationSection -> ElfRel -> (String, Bool)
get_name_and_inex_from_reloc ElfRelocationSection
sec ElfRel
reloc =
    let sym_entry :: ElfSymbolTableEntry
sym_entry     = (ElfRelocationSection -> [ElfSymbolTableEntry]
elfRelSectSymbolTable ElfRelocationSection
sec) [ElfSymbolTableEntry] -> Int -> ElfSymbolTableEntry
forall a. HasCallStack => [a] -> Int -> a
!! (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelSymbol ElfRel
reloc) in
      ElfSymbolTableEntry -> (String, Bool)
get_name_and_inex_from_sym_entry ElfSymbolTableEntry
sym_entry

  get_name_and_inex_from_sym_entry :: ElfSymbolTableEntry -> (String, Bool)
get_name_and_inex_from_sym_entry ElfSymbolTableEntry
sym_entry =
    let name :: String
name          = (Word32, Maybe ByteString) -> String
forall {a}. (a, Maybe ByteString) -> String
get_string_from_steName ((Word32, Maybe ByteString) -> String)
-> (Word32, Maybe ByteString) -> String
forall a b. (a -> b) -> a -> b
$ ElfSymbolTableEntry -> (Word32, Maybe ByteString)
steName ElfSymbolTableEntry
sym_entry
        where_defined :: ElfSectionIndex
where_defined = ElfSymbolTableEntry -> ElfSectionIndex
steIndex ElfSymbolTableEntry
sym_entry
        is_external :: Bool
is_external   = case ElfSectionIndex
where_defined of
                          ElfSectionIndex
SHNUndef   -> Bool
True
                          SHNIndex Word64
_ -> Bool
False
    in
      (String
name,Bool
is_external)

  get_symbol_type_of_reloc :: ElfRelocationSection -> ElfRel -> ElfSymbolType
get_symbol_type_of_reloc ElfRelocationSection
sec ElfRel
reloc = ElfSymbolTableEntry -> ElfSymbolType
steType (ElfSymbolTableEntry -> ElfSymbolType)
-> ElfSymbolTableEntry -> ElfSymbolType
forall a b. (a -> b) -> a -> b
$ (ElfRelocationSection -> [ElfSymbolTableEntry]
elfRelSectSymbolTable ElfRelocationSection
sec) [ElfSymbolTableEntry] -> Int -> ElfSymbolTableEntry
forall a. HasCallStack => [a] -> Int -> a
!! (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ ElfRel -> Word64
elfRelSymbol ElfRel
reloc)

  isHiddenSymEntry :: ElfSymbolTableEntry -> Bool
isHiddenSymEntry ElfSymbolTableEntry
sym_entry = ElfSymbolTableEntry -> Word8
steOther ElfSymbolTableEntry
sym_entry Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x3 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2
  is_hidden :: ElfSymbolTableEntry -> Bool
is_hidden ElfSymbolTableEntry
sym_entry = ElfSymbolTableEntry -> ElfSymbolType
steType ElfSymbolTableEntry
sym_entry ElfSymbolType -> [ElfSymbolType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ElfSymbolType
STTObject,ElfSymbolType
STTCommon] Bool -> Bool -> Bool
&& ElfSymbolTableEntry -> ElfSymbolBinding
steBind ElfSymbolTableEntry
sym_entry ElfSymbolBinding -> [ElfSymbolBinding] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ElfSymbolBinding
STBGlobal, ElfSymbolBinding
STBWeak] Bool -> Bool -> Bool
&& ElfSymbolTableEntry -> Bool
isHiddenSymEntry ElfSymbolTableEntry
sym_entry

  

-- get the name from a symbol table entry
get_string_from_steName :: (a, Maybe ByteString) -> String
get_string_from_steName (a
_, Just ByteString
name) = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
name
get_string_from_steName (a, Maybe ByteString)
_ = String
""

elf_min_address :: Elf -> Word64
elf_min_address Elf
elf = [Word64] -> Word64
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (ElfSection -> Word64) -> [ElfSection] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map ElfSection -> Word64
elfSectionAddr ([ElfSection] -> [Word64]) -> [ElfSection] -> [Word64]
forall a b. (a -> b) -> a -> b
$ (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter ElfSection -> Bool
isRelevantElfSection ([ElfSection] -> [ElfSection]) -> [ElfSection] -> [ElfSection]
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfSection]
elfSections Elf
elf

elf_max_address :: Elf -> Word64
elf_max_address Elf
elf = [Word64] -> Word64
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ (ElfSection -> Word64) -> [ElfSection] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map ElfSection -> Word64
get_max_address ([ElfSection] -> [Word64]) -> [ElfSection] -> [Word64]
forall a b. (a -> b) -> a -> b
$ (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter ElfSection -> Bool
isRelevantElfSection ([ElfSection] -> [ElfSection]) -> [ElfSection] -> [ElfSection]
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfSection]
elfSections Elf
elf
 where
  get_max_address :: ElfSection -> Word64
get_max_address ElfSection
section = ElfSection -> Word64
elfSectionAddr ElfSection
section Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ ElfSection -> Word64
elfSectionSize ElfSection
section Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1


elf_read_file :: ByteString -> Elf
elf_read_file = ByteString -> Elf
parseElf


pp_elf_section :: ElfSection -> String
pp_elf_section ElfSection
section = String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [ElfSection -> String
elfSectionName ElfSection
section, ElfSectionType -> String
forall a. Show a => a -> String
show (ElfSectionType -> String) -> ElfSectionType -> String
forall a b. (a -> b) -> a -> b
$ ElfSection -> ElfSectionType
elfSectionType ElfSection
section, Word64 -> String
forall {a}. Integral a => a -> String
showHex (ElfSection -> Word64
elfSectionAddr ElfSection
section), Word64 -> String
forall {a}. Integral a => a -> String
showHex (ElfSection -> Word64
elfSectionSize ElfSection
section), Word64 -> String
forall {a}. Integral a => a -> String
showHex (ElfSection -> Word64
elfSectionAddrAlign ElfSection
section)] String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]" 
pp_elf :: Elf -> String
pp_elf Elf
elf = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String]
pp_sections [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pp_boundaries [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pp_symbols [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pp_relocs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pp_all_relocs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pp_all_symbols [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pp_type [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
pp_entry
 where
  pp_sections :: [String]
pp_sections = (ElfSection -> String) -> [ElfSection] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ElfSection -> String
pp_elf_section ([ElfSection] -> [String]) -> [ElfSection] -> [String]
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfSection]
elfSections Elf
elf
  pp_boundaries :: [String]
pp_boundaries = [String
"Address range: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex (Elf -> Word64
elf_min_address Elf
elf) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall {a}. Integral a => a -> String
showHex (Elf -> Word64
elf_max_address Elf
elf)]
  pp_symbols :: [String]
pp_symbols = [String
"Symbol table:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ SymbolTable -> String
forall a. Show a => a -> String
show (Elf -> SymbolTable
elf_get_symbol_table Elf
elf)] 
  pp_relocs :: [String]
pp_relocs = [String
"Relocations:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Set Relocation -> String
forall a. Show a => a -> String
show (Elf -> Set Relocation
elf_get_relocs Elf
elf)] 


  pp_all_relocs :: [String]
pp_all_relocs  = String
"Complete relocation list:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (ElfRel -> String) -> [ElfRel] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ElfRel -> String
forall a. Show a => a -> String
show ((ElfRelocationSection -> [ElfRel])
-> [ElfRelocationSection] -> [ElfRel]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ElfRelocationSection -> [ElfRel]
elfRelSectRelocations ([ElfRelocationSection] -> [ElfRel])
-> [ElfRelocationSection] -> [ElfRel]
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfRelocationSection]
parseRelocations Elf
elf)
  pp_all_symbols :: [String]
pp_all_symbols = String
"Complete symbol table:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((Integer, ElfSymbolTableEntry) -> String)
-> [(Integer, ElfSymbolTableEntry)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, ElfSymbolTableEntry) -> String
forall {a}. Show a => (a, ElfSymbolTableEntry) -> String
show_symbol_entry ([Integer]
-> [ElfSymbolTableEntry] -> [(Integer, ElfSymbolTableEntry)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] ([ElfSymbolTableEntry] -> [(Integer, ElfSymbolTableEntry)])
-> [ElfSymbolTableEntry] -> [(Integer, ElfSymbolTableEntry)]
forall a b. (a -> b) -> a -> b
$ [[ElfSymbolTableEntry]] -> [ElfSymbolTableEntry]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[ElfSymbolTableEntry]] -> [ElfSymbolTableEntry])
-> [[ElfSymbolTableEntry]] -> [ElfSymbolTableEntry]
forall a b. (a -> b) -> a -> b
$ Elf -> [[ElfSymbolTableEntry]]
parseSymbolTables Elf
elf)
  show_symbol_entry :: (a, ElfSymbolTableEntry) -> String
show_symbol_entry (a
ind,ElfSymbolTableEntry
sym_entry) = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"; " [ a -> String
forall a. Show a => a -> String
show a
ind, (Word32, Maybe ByteString) -> String
forall a. Show a => a -> String
show (ElfSymbolTableEntry -> (Word32, Maybe ByteString)
steName ElfSymbolTableEntry
sym_entry), ElfSymbolType -> String
forall a. Show a => a -> String
show (ElfSymbolTableEntry -> ElfSymbolType
steType ElfSymbolTableEntry
sym_entry) , Word64 -> String
forall {a}. Integral a => a -> String
showHex (ElfSymbolTableEntry -> Word64
steValue ElfSymbolTableEntry
sym_entry), ElfSectionIndex -> String
forall a. Show a => a -> String
show (ElfSectionIndex -> String) -> ElfSectionIndex -> String
forall a b. (a -> b) -> a -> b
$ ElfSymbolTableEntry -> ElfSectionIndex
steIndex ElfSymbolTableEntry
sym_entry, ElfSymbolBinding -> String
forall a. Show a => a -> String
show (ElfSymbolBinding -> String) -> ElfSymbolBinding -> String
forall a b. (a -> b) -> a -> b
$ ElfSymbolTableEntry -> ElfSymbolBinding
steBind ElfSymbolTableEntry
sym_entry ]


  pp_type :: [String]
pp_type = [String
"Type: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (ElfType -> String
forall a. Show a => a -> String
show (ElfType -> String) -> ElfType -> String
forall a b. (a -> b) -> a -> b
$ Elf -> ElfType
elfType Elf
elf)]
  pp_entry :: [String]
pp_entry = [String
"Entry: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Word64 -> String
forall {a}. Integral a => a -> String
showHex (Word64 -> String) -> Word64 -> String
forall a b. (a -> b) -> a -> b
$ Elf -> Word64
elfEntry Elf
elf)]
  

elf_get_sections_info :: Elf -> SectionsInfo
elf_get_sections_info Elf
elf = [(String, String, Word64, Word64, Word64)]
-> Word64 -> Word64 -> SectionsInfo
SectionsInfo ((ElfSection -> (String, String, Word64, Word64, Word64))
-> [ElfSection] -> [(String, String, Word64, Word64, Word64)]
forall a b. (a -> b) -> [a] -> [b]
map ElfSection -> (String, String, Word64, Word64, Word64)
mk_section_info ([ElfSection] -> [(String, String, Word64, Word64, Word64)])
-> [ElfSection] -> [(String, String, Word64, Word64, Word64)]
forall a b. (a -> b) -> a -> b
$ (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter ElfSection -> Bool
isRelevantElfSection ([ElfSection] -> [ElfSection]) -> [ElfSection] -> [ElfSection]
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfSection]
elfSections Elf
elf) (Elf -> Word64
elf_min_address Elf
elf) (Elf -> Word64
elf_max_address Elf
elf)
 where
  mk_section_info :: ElfSection -> (String, String, Word64, Word64, Word64)
mk_section_info ElfSection
section = (String
"",ElfSection -> String
elfSectionName ElfSection
section,ElfSection -> Word64
elfSectionAddr ElfSection
section,ElfSection -> Word64
elfSectionSize ElfSection
section, ElfSection -> Word64
elfSectionAddrAlign ElfSection
section)



elf_text_section_size :: Elf -> Int
elf_text_section_size = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (Elf -> [Int]) -> Elf -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ElfSection -> Int) -> [ElfSection] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> (ElfSection -> Word64) -> ElfSection -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfSection -> Word64
elfSectionSize) ([ElfSection] -> [Int]) -> (Elf -> [ElfSection]) -> Elf -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter ElfSection -> Bool
isTextSection ([ElfSection] -> [ElfSection])
-> (Elf -> [ElfSection]) -> Elf -> [ElfSection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elf -> [ElfSection]
elfSections
 where
  isTextSection :: ElfSection -> Bool
isTextSection ElfSection
sec = (String
"",ElfSection -> String
elfSectionName ElfSection
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, String)]
sections_text

instance BinaryClass NamedElf 
  where
    binary_read_bytestring :: NamedElf -> Word64 -> Int -> Maybe ByteString
binary_read_bytestring = \(NamedElf Elf
elf String
_ String
_ SectionsInfo
_ SymbolTable
_ Set Relocation
_) -> Elf -> Word64 -> Int -> Maybe ByteString
elf_read_bytestring Elf
elf
    binary_read_ro_data :: NamedElf -> Word64 -> Int -> Maybe [Word8]
binary_read_ro_data = \(NamedElf Elf
elf String
_ String
_ SectionsInfo
_ SymbolTable
_ Set Relocation
_) -> Elf -> Word64 -> Int -> Maybe [Word8]
elf_read_ro_data Elf
elf
    binary_read_data :: NamedElf -> Word64 -> Int -> Maybe [Word8]
binary_read_data = \(NamedElf Elf
elf String
_ String
_ SectionsInfo
_ SymbolTable
_ Set Relocation
_) -> Elf -> Word64 -> Int -> Maybe [Word8]
elf_read_data Elf
elf
    binary_get_sections_info :: NamedElf -> SectionsInfo
binary_get_sections_info = \(NamedElf Elf
elf String
_ String
_ SectionsInfo
si SymbolTable
_ Set Relocation
_) -> SectionsInfo
si
    binary_get_symbols :: NamedElf -> SymbolTable
binary_get_symbols = \(NamedElf Elf
elf String
_ String
_ SectionsInfo
_ SymbolTable
t Set Relocation
_) -> SymbolTable
t
    binary_get_relocations :: NamedElf -> Set Relocation
binary_get_relocations = \(NamedElf Elf
elf String
_ String
_ SectionsInfo
_ SymbolTable
_ Set Relocation
r) -> Set Relocation
r
    binary_pp :: NamedElf -> String
binary_pp = \(NamedElf Elf
elf String
_ String
_ SectionsInfo
_ SymbolTable
_ Set Relocation
_) -> Elf -> String
pp_elf Elf
elf
    binary_entry :: NamedElf -> Word64
binary_entry = \(NamedElf Elf
elf String
_ String
_ SectionsInfo
_ SymbolTable
_ Set Relocation
_) -> Elf -> Word64
elfEntry Elf
elf
    binary_text_section_size :: NamedElf -> Int
binary_text_section_size = \(NamedElf Elf
elf String
_ String
_ SectionsInfo
_ SymbolTable
_ Set Relocation
_) -> Elf -> Int
elf_text_section_size Elf
elf
    binary_dir_name :: NamedElf -> String
binary_dir_name = \(NamedElf Elf
_ String
d String
_ SectionsInfo
_ SymbolTable
_ Set Relocation
_) -> String
d
    binary_file_name :: NamedElf -> String
binary_file_name = \(NamedElf Elf
_ String
_ String
n SectionsInfo
_ SymbolTable
_ Set Relocation
_) -> String
n