{-# LANGUAGE ScopedTypeVariables #-}

-- | Data.Elf is a module for parsing a ByteString of an ELF file into an Elf record.
module Data.Elf ( parseElf
                , parseSymbolTables
                , parseRelocations
                , findSymbolDefinition
                  -- * Top-level header
                , Elf(..)
                , ElfClass(..)
                , ElfData(..)
                , ElfOSABI(..)
                , ElfType(..)
                , ElfMachine(..)
                  -- * Sections
                , ElfSection(..)
                , ElfSectionType(..)
                , ElfSectionFlags(..)
                  -- * Segments
                , ElfSegment(..)
                , ElfSegmentType(..)
                , ElfSegmentFlag(..)
                  -- * Symbols
                , ElfSymbolTableEntry(..)
                , ElfSymbolType(..)
                , ElfSymbolBinding(..)
                , ElfSectionIndex(..)
                  -- * Relocations
                , ElfRel(..)
                , ElfRelocationSection(..)
                ) where

import Data.Binary
import Data.Binary.Get as G
import Data.Bits
import Data.Maybe
import Data.Int
import Control.Monad
import qualified Data.ByteString               as B
import qualified Data.ByteString.Internal      as B
import qualified Data.ByteString.Lazy          as L
import qualified Data.ByteString.Lazy.Internal as L

data Elf = Elf
    { Elf -> ElfClass
elfClass      :: ElfClass      -- ^ Identifies the class of the object file.
    , Elf -> ElfData
elfData       :: ElfData       -- ^ Identifies the data encoding of the object file.
    , Elf -> Int
elfVersion    :: Int           -- ^ Identifies the version of the object file format.
    , Elf -> ElfOSABI
elfOSABI      :: ElfOSABI      -- ^ Identifies the operating system and ABI for which the object is prepared.
    , Elf -> Int
elfABIVersion :: Int           -- ^ Identifies the ABI version for which the object is prepared.
    , Elf -> ElfType
elfType       :: ElfType       -- ^ Identifies the object file type.
    , Elf -> ElfMachine
elfMachine    :: ElfMachine    -- ^ Identifies the target architecture.
    , Elf -> Word64
elfEntry      :: Word64        -- ^ Virtual address of the program entry point. 0 for non-executable Elfs.
    , Elf -> [ElfSection]
elfSections   :: [ElfSection]  -- ^ List of sections in the file.
    , Elf -> [ElfSegment]
elfSegments   :: [ElfSegment]  -- ^ List of segments in the file.
    } deriving (Elf -> Elf -> Bool
(Elf -> Elf -> Bool) -> (Elf -> Elf -> Bool) -> Eq Elf
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Elf -> Elf -> Bool
$c/= :: Elf -> Elf -> Bool
== :: Elf -> Elf -> Bool
$c== :: Elf -> Elf -> Bool
Eq, Int -> Elf -> ShowS
[Elf] -> ShowS
Elf -> String
(Int -> Elf -> ShowS)
-> (Elf -> String) -> ([Elf] -> ShowS) -> Show Elf
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Elf] -> ShowS
$cshowList :: [Elf] -> ShowS
show :: Elf -> String
$cshow :: Elf -> String
showsPrec :: Int -> Elf -> ShowS
$cshowsPrec :: Int -> Elf -> ShowS
Show)

data ElfSection = ElfSection
    { ElfSection -> String
elfSectionName      :: String            -- ^ Identifies the name of the section.
    , ElfSection -> ElfSectionType
elfSectionType      :: ElfSectionType    -- ^ Identifies the type of the section.
    , ElfSection -> [ElfSectionFlags]
elfSectionFlags     :: [ElfSectionFlags] -- ^ Identifies the attributes of the section.
    , ElfSection -> Word64
elfSectionAddr      :: Word64            -- ^ The virtual address of the beginning of the section in memory. 0 for sections that are not loaded into target memory.
    , ElfSection -> Word64
elfSectionSize      :: Word64            -- ^ The size of the section. Except for SHT_NOBITS sections, this is the size of elfSectionData.
    , ElfSection -> Word32
elfSectionLink      :: Word32            -- ^ Contains a section index of an associated section, depending on section type.
    , ElfSection -> Word32
elfSectionInfo      :: Word32            -- ^ Contains extra information for the index, depending on type.
    , ElfSection -> Word64
elfSectionAddrAlign :: Word64            -- ^ Contains the required alignment of the section. Must be a power of two.
    , ElfSection -> Word64
elfSectionEntSize   :: Word64            -- ^ Size of entries if section has a table.
    , ElfSection -> ByteString
elfSectionData      :: B.ByteString      -- ^ The raw data for the section.
    } deriving (ElfSection -> ElfSection -> Bool
(ElfSection -> ElfSection -> Bool)
-> (ElfSection -> ElfSection -> Bool) -> Eq ElfSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfSection -> ElfSection -> Bool
$c/= :: ElfSection -> ElfSection -> Bool
== :: ElfSection -> ElfSection -> Bool
$c== :: ElfSection -> ElfSection -> Bool
Eq, Int -> ElfSection -> ShowS
[ElfSection] -> ShowS
ElfSection -> String
(Int -> ElfSection -> ShowS)
-> (ElfSection -> String)
-> ([ElfSection] -> ShowS)
-> Show ElfSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfSection] -> ShowS
$cshowList :: [ElfSection] -> ShowS
show :: ElfSection -> String
$cshow :: ElfSection -> String
showsPrec :: Int -> ElfSection -> ShowS
$cshowsPrec :: Int -> ElfSection -> ShowS
Show)

elfMagic :: [Word8]
elfMagic :: [Word8]
elfMagic = [Word8
0x7f, Word8
0x45, Word8
0x4c, Word8
0x46] -- "\DELELF"

getElfMagic :: Get [Word8]
getElfMagic :: Get [Word8]
getElfMagic = do
    [Word8]
ei_magic <- Int -> Get Word8 -> Get [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
4 Get Word8
getWord8
    if [Word8]
ei_magic [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8]
elfMagic
        then String -> Get [Word8]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid magic number for ELF"
        else [Word8] -> Get [Word8]
forall (m :: * -> *) a. Monad m => a -> m a
return [Word8]
ei_magic

getElfVersion :: Get Word8
getElfVersion :: Get Word8
getElfVersion = do
    Word8
ei_version <- Get Word8
getWord8
    if Word8
ei_version Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
1
        then String -> Get Word8
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid version number for ELF"
        else Word8 -> Get Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
ei_version

data ElfSectionType
    = SHT_NULL          -- ^ Identifies an empty section header.
    | SHT_PROGBITS      -- ^ Contains information defined by the program
    | SHT_SYMTAB        -- ^ Contains a linker symbol table
    | SHT_STRTAB        -- ^ Contains a string table
    | SHT_RELA          -- ^ Contains "Rela" type relocation entries
    | SHT_HASH          -- ^ Contains a symbol hash table
    | SHT_DYNAMIC       -- ^ Contains dynamic linking tables
    | SHT_NOTE          -- ^ Contains note information
    | SHT_NOBITS        -- ^ Contains uninitialized space; does not occupy any space in the file
    | SHT_REL           -- ^ Contains "Rel" type relocation entries
    | SHT_SHLIB         -- ^ Reserved
    | SHT_DYNSYM        -- ^ Contains a dynamic loader symbol table
    | SHT_EXT Word32    -- ^ Processor- or environment-specific type
    deriving (ElfSectionType -> ElfSectionType -> Bool
(ElfSectionType -> ElfSectionType -> Bool)
-> (ElfSectionType -> ElfSectionType -> Bool) -> Eq ElfSectionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfSectionType -> ElfSectionType -> Bool
$c/= :: ElfSectionType -> ElfSectionType -> Bool
== :: ElfSectionType -> ElfSectionType -> Bool
$c== :: ElfSectionType -> ElfSectionType -> Bool
Eq, Int -> ElfSectionType -> ShowS
[ElfSectionType] -> ShowS
ElfSectionType -> String
(Int -> ElfSectionType -> ShowS)
-> (ElfSectionType -> String)
-> ([ElfSectionType] -> ShowS)
-> Show ElfSectionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfSectionType] -> ShowS
$cshowList :: [ElfSectionType] -> ShowS
show :: ElfSectionType -> String
$cshow :: ElfSectionType -> String
showsPrec :: Int -> ElfSectionType -> ShowS
$cshowsPrec :: Int -> ElfSectionType -> ShowS
Show)

getElfSectionType :: ElfReader -> Get ElfSectionType
getElfSectionType :: ElfReader -> Get ElfSectionType
getElfSectionType ElfReader
er = (Word32 -> ElfSectionType) -> Get Word32 -> Get ElfSectionType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> ElfSectionType
getElfSectionType_ (Get Word32 -> Get ElfSectionType)
-> Get Word32 -> Get ElfSectionType
forall a b. (a -> b) -> a -> b
$ ElfReader -> Get Word32
getWord32 ElfReader
er
    where getElfSectionType_ :: Word32 -> ElfSectionType
getElfSectionType_ Word32
0  = ElfSectionType
SHT_NULL
          getElfSectionType_ Word32
1  = ElfSectionType
SHT_PROGBITS
          getElfSectionType_ Word32
2  = ElfSectionType
SHT_SYMTAB
          getElfSectionType_ Word32
3  = ElfSectionType
SHT_STRTAB
          getElfSectionType_ Word32
4  = ElfSectionType
SHT_RELA
          getElfSectionType_ Word32
5  = ElfSectionType
SHT_HASH
          getElfSectionType_ Word32
6  = ElfSectionType
SHT_DYNAMIC
          getElfSectionType_ Word32
7  = ElfSectionType
SHT_NOTE
          getElfSectionType_ Word32
8  = ElfSectionType
SHT_NOBITS
          getElfSectionType_ Word32
9  = ElfSectionType
SHT_REL
          getElfSectionType_ Word32
10 = ElfSectionType
SHT_SHLIB
          getElfSectionType_ Word32
11 = ElfSectionType
SHT_DYNSYM
          getElfSectionType_ Word32
n  = Word32 -> ElfSectionType
SHT_EXT Word32
n

data ElfSectionFlags
    = SHF_WRITE     -- ^ Section contains writable data
    | SHF_ALLOC     -- ^ Section is allocated in memory image of program
    | SHF_EXECINSTR -- ^ Section contains executable instructions
    | SHF_EXT Int   -- ^ Processor- or environment-specific flag
    deriving (ElfSectionFlags -> ElfSectionFlags -> Bool
(ElfSectionFlags -> ElfSectionFlags -> Bool)
-> (ElfSectionFlags -> ElfSectionFlags -> Bool)
-> Eq ElfSectionFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfSectionFlags -> ElfSectionFlags -> Bool
$c/= :: ElfSectionFlags -> ElfSectionFlags -> Bool
== :: ElfSectionFlags -> ElfSectionFlags -> Bool
$c== :: ElfSectionFlags -> ElfSectionFlags -> Bool
Eq, Int -> ElfSectionFlags -> ShowS
[ElfSectionFlags] -> ShowS
ElfSectionFlags -> String
(Int -> ElfSectionFlags -> ShowS)
-> (ElfSectionFlags -> String)
-> ([ElfSectionFlags] -> ShowS)
-> Show ElfSectionFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfSectionFlags] -> ShowS
$cshowList :: [ElfSectionFlags] -> ShowS
show :: ElfSectionFlags -> String
$cshow :: ElfSectionFlags -> String
showsPrec :: Int -> ElfSectionFlags -> ShowS
$cshowsPrec :: Int -> ElfSectionFlags -> ShowS
Show)

getElfSectionFlags :: Bits a => Int -> a -> [ElfSectionFlags]
getElfSectionFlags :: Int -> a -> [ElfSectionFlags]
getElfSectionFlags Int
0 a
word = []
getElfSectionFlags Int
1 a
word | a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
word Int
0     = ElfSectionFlags
SHF_WRITE     ElfSectionFlags -> [ElfSectionFlags] -> [ElfSectionFlags]
forall a. a -> [a] -> [a]
: Int -> a -> [ElfSectionFlags]
forall a. Bits a => Int -> a -> [ElfSectionFlags]
getElfSectionFlags Int
0 a
word
getElfSectionFlags Int
2 a
word | a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
word Int
1     = ElfSectionFlags
SHF_ALLOC     ElfSectionFlags -> [ElfSectionFlags] -> [ElfSectionFlags]
forall a. a -> [a] -> [a]
: Int -> a -> [ElfSectionFlags]
forall a. Bits a => Int -> a -> [ElfSectionFlags]
getElfSectionFlags Int
1 a
word
getElfSectionFlags Int
3 a
word | a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
word Int
2     = ElfSectionFlags
SHF_EXECINSTR ElfSectionFlags -> [ElfSectionFlags] -> [ElfSectionFlags]
forall a. a -> [a] -> [a]
: Int -> a -> [ElfSectionFlags]
forall a. Bits a => Int -> a -> [ElfSectionFlags]
getElfSectionFlags Int
2 a
word
getElfSectionFlags Int
n a
word | a -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit a
word (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) = Int -> ElfSectionFlags
SHF_EXT (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) ElfSectionFlags -> [ElfSectionFlags] -> [ElfSectionFlags]
forall a. a -> [a] -> [a]
: Int -> a -> [ElfSectionFlags]
forall a. Bits a => Int -> a -> [ElfSectionFlags]
getElfSectionFlags (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
word
getElfSectionFlags Int
n a
word = Int -> a -> [ElfSectionFlags]
forall a. Bits a => Int -> a -> [ElfSectionFlags]
getElfSectionFlags (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) a
word

getElfSectionFlags32 :: ElfReader -> Get [ElfSectionFlags]
getElfSectionFlags64 :: ElfReader -> Get [ElfSectionFlags]
getElfSectionFlags32 :: ElfReader -> Get [ElfSectionFlags]
getElfSectionFlags32 = (Word32 -> [ElfSectionFlags])
-> Get Word32 -> Get [ElfSectionFlags]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Word32 -> [ElfSectionFlags]
forall a. Bits a => Int -> a -> [ElfSectionFlags]
getElfSectionFlags Int
32) (Get Word32 -> Get [ElfSectionFlags])
-> (ElfReader -> Get Word32) -> ElfReader -> Get [ElfSectionFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfReader -> Get Word32
getWord32
getElfSectionFlags64 :: ElfReader -> Get [ElfSectionFlags]
getElfSectionFlags64 = (Word64 -> [ElfSectionFlags])
-> Get Word64 -> Get [ElfSectionFlags]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Word64 -> [ElfSectionFlags]
forall a. Bits a => Int -> a -> [ElfSectionFlags]
getElfSectionFlags Int
64) (Get Word64 -> Get [ElfSectionFlags])
-> (ElfReader -> Get Word64) -> ElfReader -> Get [ElfSectionFlags]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfReader -> Get Word64
getWord64

data ElfClass
    = ELFCLASS32 -- ^ 32-bit ELF format
    | ELFCLASS64 -- ^ 64-bit ELF format
    deriving (ElfClass -> ElfClass -> Bool
(ElfClass -> ElfClass -> Bool)
-> (ElfClass -> ElfClass -> Bool) -> Eq ElfClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfClass -> ElfClass -> Bool
$c/= :: ElfClass -> ElfClass -> Bool
== :: ElfClass -> ElfClass -> Bool
$c== :: ElfClass -> ElfClass -> Bool
Eq, Int -> ElfClass -> ShowS
[ElfClass] -> ShowS
ElfClass -> String
(Int -> ElfClass -> ShowS)
-> (ElfClass -> String) -> ([ElfClass] -> ShowS) -> Show ElfClass
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfClass] -> ShowS
$cshowList :: [ElfClass] -> ShowS
show :: ElfClass -> String
$cshow :: ElfClass -> String
showsPrec :: Int -> ElfClass -> ShowS
$cshowsPrec :: Int -> ElfClass -> ShowS
Show)

getElfClass :: Get ElfClass
getElfClass :: Get ElfClass
getElfClass = Get Word8
getWord8 Get Word8 -> (Word8 -> Get ElfClass) -> Get ElfClass
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get ElfClass
forall a (m :: * -> *).
(Eq a, Num a, MonadFail m) =>
a -> m ElfClass
getElfClass_
    where getElfClass_ :: a -> m ElfClass
getElfClass_ a
1 = ElfClass -> m ElfClass
forall (m :: * -> *) a. Monad m => a -> m a
return ElfClass
ELFCLASS32
          getElfClass_ a
2 = ElfClass -> m ElfClass
forall (m :: * -> *) a. Monad m => a -> m a
return ElfClass
ELFCLASS64
          getElfClass_ a
_ = String -> m ElfClass
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ELF class"

data ElfData
    = ELFDATA2LSB -- ^ Little-endian ELF format
    | ELFDATA2MSB -- ^ Big-endian ELF format
    deriving (ElfData -> ElfData -> Bool
(ElfData -> ElfData -> Bool)
-> (ElfData -> ElfData -> Bool) -> Eq ElfData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfData -> ElfData -> Bool
$c/= :: ElfData -> ElfData -> Bool
== :: ElfData -> ElfData -> Bool
$c== :: ElfData -> ElfData -> Bool
Eq, Int -> ElfData -> ShowS
[ElfData] -> ShowS
ElfData -> String
(Int -> ElfData -> ShowS)
-> (ElfData -> String) -> ([ElfData] -> ShowS) -> Show ElfData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfData] -> ShowS
$cshowList :: [ElfData] -> ShowS
show :: ElfData -> String
$cshow :: ElfData -> String
showsPrec :: Int -> ElfData -> ShowS
$cshowsPrec :: Int -> ElfData -> ShowS
Show)

getElfData :: Get ElfData
getElfData :: Get ElfData
getElfData = Get Word8
getWord8 Get Word8 -> (Word8 -> Get ElfData) -> Get ElfData
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Word8 -> Get ElfData
forall a (m :: * -> *).
(Eq a, Num a, MonadFail m) =>
a -> m ElfData
getElfData_
    where getElfData_ :: a -> m ElfData
getElfData_ a
1 = ElfData -> m ElfData
forall (m :: * -> *) a. Monad m => a -> m a
return ElfData
ELFDATA2LSB
          getElfData_ a
2 = ElfData -> m ElfData
forall (m :: * -> *) a. Monad m => a -> m a
return ElfData
ELFDATA2MSB
          getElfData_ a
_ = String -> m ElfData
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ELF data"

data ElfOSABI
    = ELFOSABI_SYSV       -- ^ No extensions or unspecified
    | ELFOSABI_HPUX       -- ^ Hewlett-Packard HP-UX
    | ELFOSABI_NETBSD     -- ^ NetBSD
    | ELFOSABI_LINUX      -- ^ Linux
    | ELFOSABI_SOLARIS    -- ^ Sun Solaris
    | ELFOSABI_AIX        -- ^ AIX
    | ELFOSABI_IRIX       -- ^ IRIX
    | ELFOSABI_FREEBSD    -- ^ FreeBSD
    | ELFOSABI_TRU64      -- ^ Compaq TRU64 UNIX
    | ELFOSABI_MODESTO    -- ^ Novell Modesto
    | ELFOSABI_OPENBSD    -- ^ Open BSD
    | ELFOSABI_OPENVMS    -- ^ Open VMS
    | ELFOSABI_NSK        -- ^ Hewlett-Packard Non-Stop Kernel
    | ELFOSABI_AROS       -- ^ Amiga Research OS
    | ELFOSABI_ARM        -- ^ ARM
    | ELFOSABI_STANDALONE -- ^ Standalone (embedded) application
    | ELFOSABI_EXT Word8  -- ^ Other
    deriving (ElfOSABI -> ElfOSABI -> Bool
(ElfOSABI -> ElfOSABI -> Bool)
-> (ElfOSABI -> ElfOSABI -> Bool) -> Eq ElfOSABI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfOSABI -> ElfOSABI -> Bool
$c/= :: ElfOSABI -> ElfOSABI -> Bool
== :: ElfOSABI -> ElfOSABI -> Bool
$c== :: ElfOSABI -> ElfOSABI -> Bool
Eq, Int -> ElfOSABI -> ShowS
[ElfOSABI] -> ShowS
ElfOSABI -> String
(Int -> ElfOSABI -> ShowS)
-> (ElfOSABI -> String) -> ([ElfOSABI] -> ShowS) -> Show ElfOSABI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfOSABI] -> ShowS
$cshowList :: [ElfOSABI] -> ShowS
show :: ElfOSABI -> String
$cshow :: ElfOSABI -> String
showsPrec :: Int -> ElfOSABI -> ShowS
$cshowsPrec :: Int -> ElfOSABI -> ShowS
Show)

getElfOsabi :: Get ElfOSABI
getElfOsabi :: Get ElfOSABI
getElfOsabi = (Word8 -> ElfOSABI) -> Get Word8 -> Get ElfOSABI
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word8 -> ElfOSABI
getElfOsabi_ Get Word8
getWord8
    where getElfOsabi_ :: Word8 -> ElfOSABI
getElfOsabi_ Word8
0   = ElfOSABI
ELFOSABI_SYSV
          getElfOsabi_ Word8
1   = ElfOSABI
ELFOSABI_HPUX
          getElfOsabi_ Word8
2   = ElfOSABI
ELFOSABI_NETBSD
          getElfOsabi_ Word8
3   = ElfOSABI
ELFOSABI_LINUX
          getElfOsabi_ Word8
6   = ElfOSABI
ELFOSABI_SOLARIS
          getElfOsabi_ Word8
7   = ElfOSABI
ELFOSABI_AIX
          getElfOsabi_ Word8
8   = ElfOSABI
ELFOSABI_IRIX
          getElfOsabi_ Word8
9   = ElfOSABI
ELFOSABI_FREEBSD
          getElfOsabi_ Word8
10  = ElfOSABI
ELFOSABI_TRU64
          getElfOsabi_ Word8
11  = ElfOSABI
ELFOSABI_MODESTO
          getElfOsabi_ Word8
12  = ElfOSABI
ELFOSABI_OPENBSD
          getElfOsabi_ Word8
13  = ElfOSABI
ELFOSABI_OPENVMS
          getElfOsabi_ Word8
14  = ElfOSABI
ELFOSABI_NSK
          getElfOsabi_ Word8
15  = ElfOSABI
ELFOSABI_AROS
          getElfOsabi_ Word8
97  = ElfOSABI
ELFOSABI_ARM
          getElfOsabi_ Word8
255 = ElfOSABI
ELFOSABI_STANDALONE
          getElfOsabi_ Word8
n   = Word8 -> ElfOSABI
ELFOSABI_EXT Word8
n

data ElfType
    = ET_NONE       -- ^ Unspecified type
    | ET_REL        -- ^ Relocatable object file
    | ET_EXEC       -- ^ Executable object file
    | ET_DYN        -- ^ Shared object file
    | ET_CORE       -- ^ Core dump object file
    | ET_EXT Word16 -- ^ Other
    deriving (ElfType -> ElfType -> Bool
(ElfType -> ElfType -> Bool)
-> (ElfType -> ElfType -> Bool) -> Eq ElfType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfType -> ElfType -> Bool
$c/= :: ElfType -> ElfType -> Bool
== :: ElfType -> ElfType -> Bool
$c== :: ElfType -> ElfType -> Bool
Eq, Int -> ElfType -> ShowS
[ElfType] -> ShowS
ElfType -> String
(Int -> ElfType -> ShowS)
-> (ElfType -> String) -> ([ElfType] -> ShowS) -> Show ElfType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfType] -> ShowS
$cshowList :: [ElfType] -> ShowS
show :: ElfType -> String
$cshow :: ElfType -> String
showsPrec :: Int -> ElfType -> ShowS
$cshowsPrec :: Int -> ElfType -> ShowS
Show)

getElfType :: ElfReader -> Get ElfType
getElfType :: ElfReader -> Get ElfType
getElfType = (Word16 -> ElfType) -> Get Word16 -> Get ElfType
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word16 -> ElfType
getElfType_ (Get Word16 -> Get ElfType)
-> (ElfReader -> Get Word16) -> ElfReader -> Get ElfType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfReader -> Get Word16
getWord16
    where getElfType_ :: Word16 -> ElfType
getElfType_ Word16
0 = ElfType
ET_NONE
          getElfType_ Word16
1 = ElfType
ET_REL
          getElfType_ Word16
2 = ElfType
ET_EXEC
          getElfType_ Word16
3 = ElfType
ET_DYN
          getElfType_ Word16
4 = ElfType
ET_CORE
          getElfType_ Word16
n = Word16 -> ElfType
ET_EXT Word16
n

data ElfMachine
    = EM_NONE        -- ^ No machine
    | EM_M32         -- ^ AT&T WE 32100
    | EM_SPARC       -- ^ SPARC
    | EM_386         -- ^ Intel 80386
    | EM_68K         -- ^ Motorola 68000
    | EM_88K         -- ^ Motorola 88000
    | EM_486         -- ^ Intel i486 (DO NOT USE THIS ONE)
    | EM_860         -- ^ Intel 80860
    | EM_MIPS        -- ^ MIPS I Architecture
    | EM_S370        -- ^ IBM System/370 Processor
    | EM_MIPS_RS3_LE -- ^ MIPS RS3000 Little-endian
    | EM_SPARC64     -- ^ SPARC 64-bit
    | EM_PARISC      -- ^ Hewlett-Packard PA-RISC
    | EM_VPP500      -- ^ Fujitsu VPP500
    | EM_SPARC32PLUS -- ^ Enhanced instruction set SPARC
    | EM_960         -- ^ Intel 80960
    | EM_PPC         -- ^ PowerPC
    | EM_PPC64       -- ^ 64-bit PowerPC
    | EM_S390        -- ^ IBM System/390 Processor
    | EM_SPU         -- ^ Cell SPU
    | EM_V800        -- ^ NEC V800
    | EM_FR20        -- ^ Fujitsu FR20
    | EM_RH32        -- ^ TRW RH-32
    | EM_RCE         -- ^ Motorola RCE
    | EM_ARM         -- ^ Advanced RISC Machines ARM
    | EM_ALPHA       -- ^ Digital Alpha
    | EM_SH          -- ^ Hitachi SH
    | EM_SPARCV9     -- ^ SPARC Version 9
    | EM_TRICORE     -- ^ Siemens TriCore embedded processor
    | EM_ARC         -- ^ Argonaut RISC Core, Argonaut Technologies Inc.
    | EM_H8_300      -- ^ Hitachi H8/300
    | EM_H8_300H     -- ^ Hitachi H8/300H
    | EM_H8S         -- ^ Hitachi H8S
    | EM_H8_500      -- ^ Hitachi H8/500
    | EM_IA_64       -- ^ Intel IA-64 processor architecture
    | EM_MIPS_X      -- ^ Stanford MIPS-X
    | EM_COLDFIRE    -- ^ Motorola ColdFire
    | EM_68HC12      -- ^ Motorola M68HC12
    | EM_MMA         -- ^ Fujitsu MMA Multimedia Accelerator
    | EM_PCP         -- ^ Siemens PCP
    | EM_NCPU        -- ^ Sony nCPU embedded RISC processor
    | EM_NDR1        -- ^ Denso NDR1 microprocessor
    | EM_STARCORE    -- ^ Motorola Star*Core processor
    | EM_ME16        -- ^ Toyota ME16 processor
    | EM_ST100       -- ^ STMicroelectronics ST100 processor
    | EM_TINYJ       -- ^ Advanced Logic Corp. TinyJ embedded processor family
    | EM_X86_64      -- ^ AMD x86-64 architecture
    | EM_PDSP        -- ^ Sony DSP Processor
    | EM_FX66        -- ^ Siemens FX66 microcontroller
    | EM_ST9PLUS     -- ^ STMicroelectronics ST9+ 8/16 bit microcontroller
    | EM_ST7         -- ^ STMicroelectronics ST7 8-bit microcontroller
    | EM_68HC16      -- ^ Motorola MC68HC16 Microcontroller
    | EM_68HC11      -- ^ Motorola MC68HC11 Microcontroller
    | EM_68HC08      -- ^ Motorola MC68HC08 Microcontroller
    | EM_68HC05      -- ^ Motorola MC68HC05 Microcontroller
    | EM_SVX         -- ^ Silicon Graphics SVx
    | EM_ST19        -- ^ STMicroelectronics ST19 8-bit microcontroller
    | EM_VAX         -- ^ Digital VAX
    | EM_CRIS        -- ^ Axis Communications 32-bit embedded processor
    | EM_JAVELIN     -- ^ Infineon Technologies 32-bit embedded processor
    | EM_FIREPATH    -- ^ Element 14 64-bit DSP Processor
    | EM_ZSP         -- ^ LSI Logic 16-bit DSP Processor
    | EM_MMIX        -- ^ Donald Knuth's educational 64-bit processor
    | EM_HUANY       -- ^ Harvard University machine-independent object files
    | EM_PRISM       -- ^ SiTera Prism
    | EM_AVR         -- ^ Atmel AVR 8-bit microcontroller
    | EM_FR30        -- ^ Fujitsu FR30
    | EM_D10V        -- ^ Mitsubishi D10V
    | EM_D30V        -- ^ Mitsubishi D30V
    | EM_V850        -- ^ NEC v850
    | EM_M32R        -- ^ Mitsubishi M32R
    | EM_MN10300     -- ^ Matsushita MN10300
    | EM_MN10200     -- ^ Matsushita MN10200
    | EM_PJ          -- ^ picoJava
    | EM_OPENRISC    -- ^ OpenRISC 32-bit embedded processor
    | EM_ARC_A5      -- ^ ARC Cores Tangent-A5
    | EM_XTENSA      -- ^ Tensilica Xtensa Architecture
    | EM_VIDEOCORE   -- ^ Alphamosaic VideoCore processor
    | EM_TMM_GPP     -- ^ Thompson Multimedia General Purpose Processor
    | EM_NS32K       -- ^ National Semiconductor 32000 series
    | EM_TPC         -- ^ Tenor Network TPC processor
    | EM_SNP1K       -- ^ Trebia SNP 1000 processor
    | EM_ST200       -- ^ STMicroelectronics (www.st.com) ST200 microcontroller
    | EM_IP2K        -- ^ Ubicom IP2xxx microcontroller family
    | EM_MAX         -- ^ MAX Processor
    | EM_CR          -- ^ National Semiconductor CompactRISC microprocessor
    | EM_F2MC16      -- ^ Fujitsu F2MC16
    | EM_MSP430      -- ^ Texas Instruments embedded microcontroller msp430
    | EM_BLACKFIN    -- ^ Analog Devices Blackfin (DSP) processor
    | EM_SE_C33      -- ^ S1C33 Family of Seiko Epson processors
    | EM_SEP         -- ^ Sharp embedded microprocessor
    | EM_ARCA        -- ^ Arca RISC Microprocessor
    | EM_UNICORE     -- ^ Microprocessor series from PKU-Unity Ltd. and MPRC of Peking University
    | EM_EXT Word16  -- ^ Other
    deriving (ElfMachine -> ElfMachine -> Bool
(ElfMachine -> ElfMachine -> Bool)
-> (ElfMachine -> ElfMachine -> Bool) -> Eq ElfMachine
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfMachine -> ElfMachine -> Bool
$c/= :: ElfMachine -> ElfMachine -> Bool
== :: ElfMachine -> ElfMachine -> Bool
$c== :: ElfMachine -> ElfMachine -> Bool
Eq, Int -> ElfMachine -> ShowS
[ElfMachine] -> ShowS
ElfMachine -> String
(Int -> ElfMachine -> ShowS)
-> (ElfMachine -> String)
-> ([ElfMachine] -> ShowS)
-> Show ElfMachine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfMachine] -> ShowS
$cshowList :: [ElfMachine] -> ShowS
show :: ElfMachine -> String
$cshow :: ElfMachine -> String
showsPrec :: Int -> ElfMachine -> ShowS
$cshowsPrec :: Int -> ElfMachine -> ShowS
Show)

getElfMachine :: ElfReader -> Get ElfMachine
getElfMachine :: ElfReader -> Get ElfMachine
getElfMachine = (Word16 -> ElfMachine) -> Get Word16 -> Get ElfMachine
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word16 -> ElfMachine
getElfMachine_ (Get Word16 -> Get ElfMachine)
-> (ElfReader -> Get Word16) -> ElfReader -> Get ElfMachine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfReader -> Get Word16
getWord16
    where getElfMachine_ :: Word16 -> ElfMachine
getElfMachine_ Word16
0   = ElfMachine
EM_NONE
          getElfMachine_ Word16
1   = ElfMachine
EM_M32
          getElfMachine_ Word16
2   = ElfMachine
EM_SPARC
          getElfMachine_ Word16
3   = ElfMachine
EM_386
          getElfMachine_ Word16
4   = ElfMachine
EM_68K
          getElfMachine_ Word16
5   = ElfMachine
EM_88K
          getElfMachine_ Word16
6   = ElfMachine
EM_486
          getElfMachine_ Word16
7   = ElfMachine
EM_860
          getElfMachine_ Word16
8   = ElfMachine
EM_MIPS
          getElfMachine_ Word16
9   = ElfMachine
EM_S370
          getElfMachine_ Word16
10  = ElfMachine
EM_MIPS_RS3_LE
          getElfMachine_ Word16
11  = ElfMachine
EM_SPARC64
          getElfMachine_ Word16
15  = ElfMachine
EM_PARISC
          getElfMachine_ Word16
17  = ElfMachine
EM_VPP500
          getElfMachine_ Word16
18  = ElfMachine
EM_SPARC32PLUS
          getElfMachine_ Word16
19  = ElfMachine
EM_960
          getElfMachine_ Word16
20  = ElfMachine
EM_PPC
          getElfMachine_ Word16
21  = ElfMachine
EM_PPC64
          getElfMachine_ Word16
22  = ElfMachine
EM_S390
          getElfMachine_ Word16
23  = ElfMachine
EM_SPU
          getElfMachine_ Word16
36  = ElfMachine
EM_V800
          getElfMachine_ Word16
37  = ElfMachine
EM_FR20
          getElfMachine_ Word16
38  = ElfMachine
EM_RH32
          getElfMachine_ Word16
39  = ElfMachine
EM_RCE
          getElfMachine_ Word16
40  = ElfMachine
EM_ARM
          getElfMachine_ Word16
41  = ElfMachine
EM_ALPHA
          getElfMachine_ Word16
42  = ElfMachine
EM_SH
          getElfMachine_ Word16
43  = ElfMachine
EM_SPARCV9
          getElfMachine_ Word16
44  = ElfMachine
EM_TRICORE
          getElfMachine_ Word16
45  = ElfMachine
EM_ARC
          getElfMachine_ Word16
46  = ElfMachine
EM_H8_300
          getElfMachine_ Word16
47  = ElfMachine
EM_H8_300H
          getElfMachine_ Word16
48  = ElfMachine
EM_H8S
          getElfMachine_ Word16
49  = ElfMachine
EM_H8_500
          getElfMachine_ Word16
50  = ElfMachine
EM_IA_64
          getElfMachine_ Word16
51  = ElfMachine
EM_MIPS_X
          getElfMachine_ Word16
52  = ElfMachine
EM_COLDFIRE
          getElfMachine_ Word16
53  = ElfMachine
EM_68HC12
          getElfMachine_ Word16
54  = ElfMachine
EM_MMA
          getElfMachine_ Word16
55  = ElfMachine
EM_PCP
          getElfMachine_ Word16
56  = ElfMachine
EM_NCPU
          getElfMachine_ Word16
57  = ElfMachine
EM_NDR1
          getElfMachine_ Word16
58  = ElfMachine
EM_STARCORE
          getElfMachine_ Word16
59  = ElfMachine
EM_ME16
          getElfMachine_ Word16
60  = ElfMachine
EM_ST100
          getElfMachine_ Word16
61  = ElfMachine
EM_TINYJ
          getElfMachine_ Word16
62  = ElfMachine
EM_X86_64
          getElfMachine_ Word16
63  = ElfMachine
EM_PDSP
          getElfMachine_ Word16
66  = ElfMachine
EM_FX66
          getElfMachine_ Word16
67  = ElfMachine
EM_ST9PLUS
          getElfMachine_ Word16
68  = ElfMachine
EM_ST7
          getElfMachine_ Word16
69  = ElfMachine
EM_68HC16
          getElfMachine_ Word16
70  = ElfMachine
EM_68HC11
          getElfMachine_ Word16
71  = ElfMachine
EM_68HC08
          getElfMachine_ Word16
72  = ElfMachine
EM_68HC05
          getElfMachine_ Word16
73  = ElfMachine
EM_SVX
          getElfMachine_ Word16
74  = ElfMachine
EM_ST19
          getElfMachine_ Word16
75  = ElfMachine
EM_VAX
          getElfMachine_ Word16
76  = ElfMachine
EM_CRIS
          getElfMachine_ Word16
77  = ElfMachine
EM_JAVELIN
          getElfMachine_ Word16
78  = ElfMachine
EM_FIREPATH
          getElfMachine_ Word16
79  = ElfMachine
EM_ZSP
          getElfMachine_ Word16
80  = ElfMachine
EM_MMIX
          getElfMachine_ Word16
81  = ElfMachine
EM_HUANY
          getElfMachine_ Word16
82  = ElfMachine
EM_PRISM
          getElfMachine_ Word16
83  = ElfMachine
EM_AVR
          getElfMachine_ Word16
84  = ElfMachine
EM_FR30
          getElfMachine_ Word16
85  = ElfMachine
EM_D10V
          getElfMachine_ Word16
86  = ElfMachine
EM_D30V
          getElfMachine_ Word16
87  = ElfMachine
EM_V850
          getElfMachine_ Word16
88  = ElfMachine
EM_M32R
          getElfMachine_ Word16
89  = ElfMachine
EM_MN10300
          getElfMachine_ Word16
90  = ElfMachine
EM_MN10200
          getElfMachine_ Word16
91  = ElfMachine
EM_PJ
          getElfMachine_ Word16
92  = ElfMachine
EM_OPENRISC
          getElfMachine_ Word16
93  = ElfMachine
EM_ARC_A5
          getElfMachine_ Word16
94  = ElfMachine
EM_XTENSA
          getElfMachine_ Word16
95  = ElfMachine
EM_VIDEOCORE
          getElfMachine_ Word16
96  = ElfMachine
EM_TMM_GPP
          getElfMachine_ Word16
97  = ElfMachine
EM_NS32K
          getElfMachine_ Word16
98  = ElfMachine
EM_TPC
          getElfMachine_ Word16
99  = ElfMachine
EM_SNP1K
          getElfMachine_ Word16
100 = ElfMachine
EM_ST200
          getElfMachine_ Word16
101 = ElfMachine
EM_IP2K
          getElfMachine_ Word16
102 = ElfMachine
EM_MAX
          getElfMachine_ Word16
103 = ElfMachine
EM_CR
          getElfMachine_ Word16
104 = ElfMachine
EM_F2MC16
          getElfMachine_ Word16
105 = ElfMachine
EM_MSP430
          getElfMachine_ Word16
106 = ElfMachine
EM_BLACKFIN
          getElfMachine_ Word16
107 = ElfMachine
EM_SE_C33
          getElfMachine_ Word16
108 = ElfMachine
EM_SEP
          getElfMachine_ Word16
109 = ElfMachine
EM_ARCA
          getElfMachine_ Word16
110 = ElfMachine
EM_UNICORE
          getElfMachine_ Word16
n   = Word16 -> ElfMachine
EM_EXT Word16
n

getElf_Shdr_OffsetSize :: ElfClass -> ElfReader -> Get (Word64, Word64)
getElf_Shdr_OffsetSize :: ElfClass -> ElfReader -> Get (Word64, Word64)
getElf_Shdr_OffsetSize ElfClass
ei_class ElfReader
er =
    case ElfClass
ei_class of
        ElfClass
ELFCLASS32 -> do
            Int -> Get ()
skip Int
16
            Word64
sh_offset <- (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Word32 -> Get Word64) -> Get Word32 -> Get Word64
forall a b. (a -> b) -> a -> b
$ ElfReader -> Get Word32
getWord32 ElfReader
er
            Word64
sh_size   <- (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Word32 -> Get Word64) -> Get Word32 -> Get Word64
forall a b. (a -> b) -> a -> b
$ ElfReader -> Get Word32
getWord32 ElfReader
er
            (Word64, Word64) -> Get (Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
sh_offset, Word64
sh_size)
        ElfClass
ELFCLASS64 -> do
            Int -> Get ()
skip Int
24
            Word64
sh_offset <- ElfReader -> Get Word64
getWord64 ElfReader
er
            Word64
sh_size   <- ElfReader -> Get Word64
getWord64 ElfReader
er
            (Word64, Word64) -> Get (Word64, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
sh_offset, Word64
sh_size)

getElf_Shdr :: ElfClass -> ElfReader -> B.ByteString -> B.ByteString -> Get ElfSection
getElf_Shdr :: ElfClass -> ElfReader -> ByteString -> ByteString -> Get ElfSection
getElf_Shdr ElfClass
ei_class ElfReader
er ByteString
elf_file ByteString
string_section =
    case ElfClass
ei_class of
        ElfClass
ELFCLASS32 -> do
            Word32
sh_name      <- ElfReader -> Get Word32
getWord32 ElfReader
er
            ElfSectionType
sh_type      <- ElfReader -> Get ElfSectionType
getElfSectionType ElfReader
er
            [ElfSectionFlags]
sh_flags     <- ElfReader -> Get [ElfSectionFlags]
getElfSectionFlags32 ElfReader
er
            Word32
sh_addr      <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word32
sh_offset    <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word32
sh_size      <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word32
sh_link      <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word32
sh_info      <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word32
sh_addralign <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word32
sh_entsize   <- ElfReader -> Get Word32
getWord32 ElfReader
er
            ElfSection -> Get ElfSection
forall (m :: * -> *) a. Monad m => a -> m a
return ElfSection :: String
-> ElfSectionType
-> [ElfSectionFlags]
-> Word64
-> Word64
-> Word32
-> Word32
-> Word64
-> Word64
-> ByteString
-> ElfSection
ElfSection
                { elfSectionName :: String
elfSectionName      = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Char
B.w2c ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sh_name) ByteString
string_section
                , elfSectionType :: ElfSectionType
elfSectionType      = ElfSectionType
sh_type
                , elfSectionFlags :: [ElfSectionFlags]
elfSectionFlags     = [ElfSectionFlags]
sh_flags
                , elfSectionAddr :: Word64
elfSectionAddr      = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sh_addr
                , elfSectionSize :: Word64
elfSectionSize      = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sh_size
                , elfSectionLink :: Word32
elfSectionLink      = Word32
sh_link
                , elfSectionInfo :: Word32
elfSectionInfo      = Word32
sh_info
                , elfSectionAddrAlign :: Word64
elfSectionAddrAlign = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sh_addralign
                , elfSectionEntSize :: Word64
elfSectionEntSize   = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sh_entsize
                , elfSectionData :: ByteString
elfSectionData      = Int -> ByteString -> ByteString
B.take (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sh_size) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sh_offset) ByteString
elf_file
                }
        ElfClass
ELFCLASS64 -> do
            Word32
sh_name      <- ElfReader -> Get Word32
getWord32 ElfReader
er
            ElfSectionType
sh_type      <- ElfReader -> Get ElfSectionType
getElfSectionType ElfReader
er
            [ElfSectionFlags]
sh_flags     <- ElfReader -> Get [ElfSectionFlags]
getElfSectionFlags64 ElfReader
er
            Word64
sh_addr      <- ElfReader -> Get Word64
getWord64 ElfReader
er
            Word64
sh_offset    <- ElfReader -> Get Word64
getWord64 ElfReader
er
            Word64
sh_size      <- ElfReader -> Get Word64
getWord64 ElfReader
er
            Word32
sh_link      <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word32
sh_info      <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word64
sh_addralign <- ElfReader -> Get Word64
getWord64 ElfReader
er
            Word64
sh_entsize   <- ElfReader -> Get Word64
getWord64 ElfReader
er
            ElfSection -> Get ElfSection
forall (m :: * -> *) a. Monad m => a -> m a
return ElfSection :: String
-> ElfSectionType
-> [ElfSectionFlags]
-> Word64
-> Word64
-> Word32
-> Word32
-> Word64
-> Word64
-> ByteString
-> ElfSection
ElfSection
                { elfSectionName :: String
elfSectionName      = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Char
B.w2c ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
sh_name) ByteString
string_section
                , elfSectionType :: ElfSectionType
elfSectionType      = ElfSectionType
sh_type
                , elfSectionFlags :: [ElfSectionFlags]
elfSectionFlags     = [ElfSectionFlags]
sh_flags
                , elfSectionAddr :: Word64
elfSectionAddr      = Word64
sh_addr
                , elfSectionSize :: Word64
elfSectionSize      = Word64
sh_size
                , elfSectionLink :: Word32
elfSectionLink      = Word32
sh_link
                , elfSectionInfo :: Word32
elfSectionInfo      = Word32
sh_info
                , elfSectionAddrAlign :: Word64
elfSectionAddrAlign = Word64
sh_addralign
                , elfSectionEntSize :: Word64
elfSectionEntSize   = Word64
sh_entsize
                , elfSectionData :: ByteString
elfSectionData      = Int -> ByteString -> ByteString
B.take (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sh_size) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
sh_offset) ByteString
elf_file
                }

data TableInfo = TableInfo { TableInfo -> Int
tableOffset :: Int, TableInfo -> Int
entrySize :: Int, TableInfo -> Int
entryNum :: Int }

getElf_Ehdr :: Get (Elf, TableInfo, TableInfo, Word16)
getElf_Ehdr :: Get (Elf, TableInfo, TableInfo, Word16)
getElf_Ehdr = do
    [Word8]
ei_magic    <- Get [Word8]
getElfMagic
    ElfClass
ei_class    <- Get ElfClass
getElfClass
    ElfData
ei_data     <- Get ElfData
getElfData
    Int
ei_version  <- (Word8 -> Int) -> Get Word8 -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word8
getElfVersion
    ElfOSABI
ei_osabi    <- Get ElfOSABI
getElfOsabi
    Int
ei_abiver   <- (Word8 -> Int) -> Get Word8 -> Get Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word8
getWord8
    Int -> Get ()
skip Int
7
    ElfReader
er          <- ElfReader -> Get ElfReader
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfReader -> Get ElfReader) -> ElfReader -> Get ElfReader
forall a b. (a -> b) -> a -> b
$ ElfData -> ElfReader
elfReader ElfData
ei_data
    case ElfClass
ei_class of
        ElfClass
ELFCLASS32 -> do
            ElfType
e_type      <- ElfReader -> Get ElfType
getElfType ElfReader
er
            ElfMachine
e_machine   <- ElfReader -> Get ElfMachine
getElfMachine ElfReader
er
            Word32
e_version   <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word64
e_entry     <- (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Word32 -> Get Word64) -> Get Word32 -> Get Word64
forall a b. (a -> b) -> a -> b
$ ElfReader -> Get Word32
getWord32 ElfReader
er
            Word32
e_phoff     <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Integer
e_shoff     <- (Word32 -> Integer) -> Get Word32 -> Get Integer
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Get Word32 -> Get Integer) -> Get Word32 -> Get Integer
forall a b. (a -> b) -> a -> b
$ ElfReader -> Get Word32
getWord32 ElfReader
er
            Word32
e_flags     <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word16
e_ehsize    <- ElfReader -> Get Word16
getWord16 ElfReader
er
            Word16
e_phentsize <- ElfReader -> Get Word16
getWord16 ElfReader
er
            Word16
e_phnum     <- ElfReader -> Get Word16
getWord16 ElfReader
er
            Word16
e_shentsize <- ElfReader -> Get Word16
getWord16 ElfReader
er
            Word16
e_shnum     <- ElfReader -> Get Word16
getWord16 ElfReader
er
            Word16
e_shstrndx  <- ElfReader -> Get Word16
getWord16 ElfReader
er
            (Elf, TableInfo, TableInfo, Word16)
-> Get (Elf, TableInfo, TableInfo, Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return (Elf :: ElfClass
-> ElfData
-> Int
-> ElfOSABI
-> Int
-> ElfType
-> ElfMachine
-> Word64
-> [ElfSection]
-> [ElfSegment]
-> Elf
Elf { elfClass :: ElfClass
elfClass      = ElfClass
ei_class
                        , elfData :: ElfData
elfData       = ElfData
ei_data
                        , elfVersion :: Int
elfVersion    = Int
ei_version
                        , elfOSABI :: ElfOSABI
elfOSABI      = ElfOSABI
ei_osabi
                        , elfABIVersion :: Int
elfABIVersion = Int
ei_abiver
                        , elfType :: ElfType
elfType       = ElfType
e_type
                        , elfMachine :: ElfMachine
elfMachine    = ElfMachine
e_machine
                        , elfEntry :: Word64
elfEntry      = Word64
e_entry
                        , elfSections :: [ElfSection]
elfSections   = []
                        , elfSegments :: [ElfSegment]
elfSegments   = [] }
                   , TableInfo :: Int -> Int -> Int -> TableInfo
TableInfo { tableOffset :: Int
tableOffset = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
e_phoff, entrySize :: Int
entrySize = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
e_phentsize, entryNum :: Int
entryNum = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
e_phnum }
                   , TableInfo :: Int -> Int -> Int -> TableInfo
TableInfo { tableOffset :: Int
tableOffset = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
e_shoff, entrySize :: Int
entrySize = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
e_shentsize, entryNum :: Int
entryNum = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
e_shnum }
                   , Word16
e_shstrndx)
        ElfClass
ELFCLASS64 -> do
            ElfType
e_type      <- ElfReader -> Get ElfType
getElfType ElfReader
er
            ElfMachine
e_machine   <- ElfReader -> Get ElfMachine
getElfMachine ElfReader
er
            Word32
e_version   <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word64
e_entry     <- ElfReader -> Get Word64
getWord64 ElfReader
er
            Word64
e_phoff     <- ElfReader -> Get Word64
getWord64 ElfReader
er
            Word64
e_shoff     <- ElfReader -> Get Word64
getWord64 ElfReader
er
            Word32
e_flags     <- ElfReader -> Get Word32
getWord32 ElfReader
er
            Word16
e_ehsize    <- ElfReader -> Get Word16
getWord16 ElfReader
er
            Word16
e_phentsize <- ElfReader -> Get Word16
getWord16 ElfReader
er
            Word16
e_phnum     <- ElfReader -> Get Word16
getWord16 ElfReader
er
            Word16
e_shentsize <- ElfReader -> Get Word16
getWord16 ElfReader
er
            Word16
e_shnum     <- ElfReader -> Get Word16
getWord16 ElfReader
er
            Word16
e_shstrndx  <- ElfReader -> Get Word16
getWord16 ElfReader
er
            (Elf, TableInfo, TableInfo, Word16)
-> Get (Elf, TableInfo, TableInfo, Word16)
forall (m :: * -> *) a. Monad m => a -> m a
return (Elf :: ElfClass
-> ElfData
-> Int
-> ElfOSABI
-> Int
-> ElfType
-> ElfMachine
-> Word64
-> [ElfSection]
-> [ElfSegment]
-> Elf
Elf { elfClass :: ElfClass
elfClass      = ElfClass
ei_class
                        , elfData :: ElfData
elfData       = ElfData
ei_data
                        , elfVersion :: Int
elfVersion    = Int
ei_version
                        , elfOSABI :: ElfOSABI
elfOSABI      = ElfOSABI
ei_osabi
                        , elfABIVersion :: Int
elfABIVersion = Int
ei_abiver
                        , elfType :: ElfType
elfType       = ElfType
e_type
                        , elfMachine :: ElfMachine
elfMachine    = ElfMachine
e_machine
                        , elfEntry :: Word64
elfEntry      = Word64
e_entry
                        , elfSections :: [ElfSection]
elfSections   = []
                        , elfSegments :: [ElfSegment]
elfSegments   = [] }
                   , TableInfo :: Int -> Int -> Int -> TableInfo
TableInfo { tableOffset :: Int
tableOffset = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
e_phoff, entrySize :: Int
entrySize = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
e_phentsize, entryNum :: Int
entryNum = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
e_phnum }
                   , TableInfo :: Int -> Int -> Int -> TableInfo
TableInfo { tableOffset :: Int
tableOffset = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
e_shoff, entrySize :: Int
entrySize = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
e_shentsize, entryNum :: Int
entryNum = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
e_shnum }
                   , Word16
e_shstrndx)

data ElfReader = ElfReader
    { ElfReader -> Get Word16
getWord16 :: Get Word16
    , ElfReader -> Get Word32
getWord32 :: Get Word32
    , ElfReader -> Get Word64
getWord64 :: Get Word64
    }

elfReader :: ElfData -> ElfReader
elfReader :: ElfData -> ElfReader
elfReader ElfData
ELFDATA2LSB = ElfReader :: Get Word16 -> Get Word32 -> Get Word64 -> ElfReader
ElfReader { getWord16 :: Get Word16
getWord16 = Get Word16
getWord16le, getWord32 :: Get Word32
getWord32 = Get Word32
getWord32le, getWord64 :: Get Word64
getWord64 = Get Word64
getWord64le }
elfReader ElfData
ELFDATA2MSB = ElfReader :: Get Word16 -> Get Word32 -> Get Word64 -> ElfReader
ElfReader { getWord16 :: Get Word16
getWord16 = Get Word16
getWord16be, getWord32 :: Get Word32
getWord32 = Get Word32
getWord32be, getWord64 :: Get Word64
getWord64 = Get Word64
getWord64be }

divide :: B.ByteString -> Int -> Int -> [B.ByteString]
divide :: ByteString -> Int -> Int -> [ByteString]
divide  ByteString
_ Int
_ Int
0 = []
divide ByteString
bs Int
s Int
n = let (ByteString
x,ByteString
y) = Int -> ByteString -> (ByteString, ByteString)
B.splitAt Int
s ByteString
bs in ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> Int -> Int -> [ByteString]
divide ByteString
y Int
s (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)

-- | Parses a ByteString into an Elf record. Parse failures call error. 32-bit ELF objects have their
-- fields promoted to 64-bit so that the 32- and 64-bit ELF records can be the same.
parseElf :: B.ByteString -> Elf
parseElf :: ByteString -> Elf
parseElf ByteString
b =
    let ph :: [ByteString]
ph                                             = TableInfo -> [ByteString]
table TableInfo
segTab
        sh :: [ByteString]
sh                                             = TableInfo -> [ByteString]
table TableInfo
secTab
        (Word64
shstroff, Word64
shstrsize)                          = (ElfClass -> ElfReader -> Get (Word64, Word64))
-> ByteString -> (Word64, Word64)
forall a. (ElfClass -> ElfReader -> Get a) -> ByteString -> a
parseEntry ElfClass -> ElfReader -> Get (Word64, Word64)
getElf_Shdr_OffsetSize (ByteString -> (Word64, Word64)) -> ByteString -> (Word64, Word64)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop (Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
e_shstrndx) [ByteString]
sh
        sh_str :: ByteString
sh_str                                         = Int -> ByteString -> ByteString
B.take (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
shstrsize) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
shstroff) ByteString
b
        segments :: [ElfSegment]
segments                                       = (ByteString -> ElfSegment) -> [ByteString] -> [ElfSegment]
forall a b. (a -> b) -> [a] -> [b]
map ((ElfClass -> ElfReader -> Get ElfSegment)
-> ByteString -> ElfSegment
forall a. (ElfClass -> ElfReader -> Get a) -> ByteString -> a
parseEntry (\ElfClass
c ElfReader
r -> ElfClass -> ElfReader -> ByteString -> Get ElfSegment
parseElfSegmentEntry ElfClass
c ElfReader
r ByteString
b)) [ByteString]
ph
        sections :: [ElfSection]
sections                                       = (ByteString -> ElfSection) -> [ByteString] -> [ElfSection]
forall a b. (a -> b) -> [a] -> [b]
map ((ElfClass -> ElfReader -> Get ElfSection)
-> ByteString -> ElfSection
forall a. (ElfClass -> ElfReader -> Get a) -> ByteString -> a
parseEntry (\ElfClass
c ElfReader
r -> ElfClass -> ElfReader -> ByteString -> ByteString -> Get ElfSection
getElf_Shdr ElfClass
c ElfReader
r ByteString
b ByteString
sh_str)) [ByteString]
sh
    in Elf
e { elfSections :: [ElfSection]
elfSections = [ElfSection]
sections, elfSegments :: [ElfSegment]
elfSegments = [ElfSegment]
segments }

  where table :: TableInfo -> [ByteString]
table TableInfo
i                         = ByteString -> Int -> Int -> [ByteString]
divide (Int -> ByteString -> ByteString
B.drop (TableInfo -> Int
tableOffset TableInfo
i) ByteString
b) (TableInfo -> Int
entrySize TableInfo
i) (TableInfo -> Int
entryNum TableInfo
i)
        parseEntry :: (ElfClass -> ElfReader -> Get a) -> ByteString -> a
parseEntry ElfClass -> ElfReader -> Get a
p ByteString
x                  = Get a -> ByteString -> a
forall a. Get a -> ByteString -> a
runGet (ElfClass -> ElfReader -> Get a
p (Elf -> ElfClass
elfClass Elf
e) (ElfData -> ElfReader
elfReader (Elf -> ElfData
elfData Elf
e))) ([ByteString] -> ByteString
L.fromChunks [ByteString
x])
        (Elf
e, TableInfo
segTab, TableInfo
secTab, Word16
e_shstrndx) = Get (Elf, TableInfo, TableInfo, Word16)
-> ByteString -> (Elf, TableInfo, TableInfo, Word16)
forall a. Get a -> ByteString -> a
runGet Get (Elf, TableInfo, TableInfo, Word16)
getElf_Ehdr (ByteString -> (Elf, TableInfo, TableInfo, Word16))
-> ByteString -> (Elf, TableInfo, TableInfo, Word16)
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
L.fromChunks [ByteString
b]


data ElfSegment = ElfSegment
  { ElfSegment -> ElfSegmentType
elfSegmentType      :: ElfSegmentType   -- ^ Segment type
  , ElfSegment -> [ElfSegmentFlag]
elfSegmentFlags     :: [ElfSegmentFlag] -- ^ Segment flags
  , ElfSegment -> Word64
elfSegmentVirtAddr  :: Word64           -- ^ Virtual address for the segment
  , ElfSegment -> Word64
elfSegmentPhysAddr  :: Word64           -- ^ Physical address for the segment
  , ElfSegment -> Word64
elfSegmentAlign     :: Word64           -- ^ Segment alignment
  , ElfSegment -> ByteString
elfSegmentData      :: B.ByteString     -- ^ Data for the segment
  , ElfSegment -> Word64
elfSegmentMemSize   :: Word64           -- ^ Size in memory  (may be larger then the segment's data)
  } deriving (ElfSegment -> ElfSegment -> Bool
(ElfSegment -> ElfSegment -> Bool)
-> (ElfSegment -> ElfSegment -> Bool) -> Eq ElfSegment
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfSegment -> ElfSegment -> Bool
$c/= :: ElfSegment -> ElfSegment -> Bool
== :: ElfSegment -> ElfSegment -> Bool
$c== :: ElfSegment -> ElfSegment -> Bool
Eq,Int -> ElfSegment -> ShowS
[ElfSegment] -> ShowS
ElfSegment -> String
(Int -> ElfSegment -> ShowS)
-> (ElfSegment -> String)
-> ([ElfSegment] -> ShowS)
-> Show ElfSegment
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfSegment] -> ShowS
$cshowList :: [ElfSegment] -> ShowS
show :: ElfSegment -> String
$cshow :: ElfSegment -> String
showsPrec :: Int -> ElfSegment -> ShowS
$cshowsPrec :: Int -> ElfSegment -> ShowS
Show)

-- | Segment Types.
data ElfSegmentType
  = PT_NULL         -- ^ Unused entry
  | PT_LOAD         -- ^ Loadable segment
  | PT_DYNAMIC      -- ^ Dynamic linking tables
  | PT_INTERP       -- ^ Program interpreter path name
  | PT_NOTE         -- ^ Note sectionks
  | PT_SHLIB        -- ^ Reserved
  | PT_PHDR         -- ^ Program header table
  | PT_Other Word32 -- ^ Some other type
    deriving (ElfSegmentType -> ElfSegmentType -> Bool
(ElfSegmentType -> ElfSegmentType -> Bool)
-> (ElfSegmentType -> ElfSegmentType -> Bool) -> Eq ElfSegmentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfSegmentType -> ElfSegmentType -> Bool
$c/= :: ElfSegmentType -> ElfSegmentType -> Bool
== :: ElfSegmentType -> ElfSegmentType -> Bool
$c== :: ElfSegmentType -> ElfSegmentType -> Bool
Eq,Int -> ElfSegmentType -> ShowS
[ElfSegmentType] -> ShowS
ElfSegmentType -> String
(Int -> ElfSegmentType -> ShowS)
-> (ElfSegmentType -> String)
-> ([ElfSegmentType] -> ShowS)
-> Show ElfSegmentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfSegmentType] -> ShowS
$cshowList :: [ElfSegmentType] -> ShowS
show :: ElfSegmentType -> String
$cshow :: ElfSegmentType -> String
showsPrec :: Int -> ElfSegmentType -> ShowS
$cshowsPrec :: Int -> ElfSegmentType -> ShowS
Show)

parseElfSegmentType :: Word32 -> ElfSegmentType
parseElfSegmentType :: Word32 -> ElfSegmentType
parseElfSegmentType Word32
x =
  case Word32
x of
    Word32
0 -> ElfSegmentType
PT_NULL
    Word32
1 -> ElfSegmentType
PT_LOAD
    Word32
2 -> ElfSegmentType
PT_DYNAMIC
    Word32
3 -> ElfSegmentType
PT_INTERP
    Word32
4 -> ElfSegmentType
PT_NOTE
    Word32
5 -> ElfSegmentType
PT_SHLIB
    Word32
6 -> ElfSegmentType
PT_PHDR
    Word32
_ -> Word32 -> ElfSegmentType
PT_Other Word32
x


parseElfSegmentEntry :: ElfClass -> ElfReader -> B.ByteString -> Get ElfSegment
parseElfSegmentEntry :: ElfClass -> ElfReader -> ByteString -> Get ElfSegment
parseElfSegmentEntry ElfClass
elf_class ElfReader
er ByteString
elf_file = case ElfClass
elf_class of
  ElfClass
ELFCLASS64 -> do
     ElfSegmentType
p_type   <- Word32 -> ElfSegmentType
parseElfSegmentType  (Word32 -> ElfSegmentType) -> Get Word32 -> Get ElfSegmentType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ElfReader -> Get Word32
getWord32 ElfReader
er
     [ElfSegmentFlag]
p_flags  <- Word32 -> [ElfSegmentFlag]
parseElfSegmentFlags (Word32 -> [ElfSegmentFlag]) -> Get Word32 -> Get [ElfSegmentFlag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ElfReader -> Get Word32
getWord32 ElfReader
er
     Word64
p_offset <- ElfReader -> Get Word64
getWord64 ElfReader
er
     Word64
p_vaddr  <- ElfReader -> Get Word64
getWord64 ElfReader
er
     Word64
p_paddr  <- ElfReader -> Get Word64
getWord64 ElfReader
er
     Word64
p_filesz <- ElfReader -> Get Word64
getWord64 ElfReader
er
     Word64
p_memsz  <- ElfReader -> Get Word64
getWord64 ElfReader
er
     Word64
p_align  <- ElfReader -> Get Word64
getWord64 ElfReader
er
     ElfSegment -> Get ElfSegment
forall (m :: * -> *) a. Monad m => a -> m a
return ElfSegment :: ElfSegmentType
-> [ElfSegmentFlag]
-> Word64
-> Word64
-> Word64
-> ByteString
-> Word64
-> ElfSegment
ElfSegment
       { elfSegmentType :: ElfSegmentType
elfSegmentType     = ElfSegmentType
p_type
       , elfSegmentFlags :: [ElfSegmentFlag]
elfSegmentFlags    = [ElfSegmentFlag]
p_flags
       , elfSegmentVirtAddr :: Word64
elfSegmentVirtAddr = Word64
p_vaddr
       , elfSegmentPhysAddr :: Word64
elfSegmentPhysAddr = Word64
p_paddr
       , elfSegmentAlign :: Word64
elfSegmentAlign    = Word64
p_align
       , elfSegmentData :: ByteString
elfSegmentData     = Int -> ByteString -> ByteString
B.take (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
p_filesz) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
p_offset) ByteString
elf_file
       , elfSegmentMemSize :: Word64
elfSegmentMemSize  = Word64
p_memsz
       }

  ElfClass
ELFCLASS32 -> do
     ElfSegmentType
p_type   <- Word32 -> ElfSegmentType
parseElfSegmentType  (Word32 -> ElfSegmentType) -> Get Word32 -> Get ElfSegmentType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ElfReader -> Get Word32
getWord32 ElfReader
er
     Integer
p_offset <- Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> Get Word32 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ElfReader -> Get Word32
getWord32 ElfReader
er
     Word64
p_vaddr  <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ElfReader -> Get Word32
getWord32 ElfReader
er
     Word64
p_paddr  <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ElfReader -> Get Word32
getWord32 ElfReader
er
     Integer
p_filesz <- Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer) -> Get Word32 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ElfReader -> Get Word32
getWord32 ElfReader
er
     Word64
p_memsz  <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ElfReader -> Get Word32
getWord32 ElfReader
er
     [ElfSegmentFlag]
p_flags  <- Word32 -> [ElfSegmentFlag]
parseElfSegmentFlags (Word32 -> [ElfSegmentFlag]) -> Get Word32 -> Get [ElfSegmentFlag]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ElfReader -> Get Word32
getWord32 ElfReader
er
     Word64
p_align  <- Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ElfReader -> Get Word32
getWord32 ElfReader
er
     ElfSegment -> Get ElfSegment
forall (m :: * -> *) a. Monad m => a -> m a
return ElfSegment :: ElfSegmentType
-> [ElfSegmentFlag]
-> Word64
-> Word64
-> Word64
-> ByteString
-> Word64
-> ElfSegment
ElfSegment
       { elfSegmentType :: ElfSegmentType
elfSegmentType     = ElfSegmentType
p_type
       , elfSegmentFlags :: [ElfSegmentFlag]
elfSegmentFlags    = [ElfSegmentFlag]
p_flags
       , elfSegmentVirtAddr :: Word64
elfSegmentVirtAddr = Word64
p_vaddr
       , elfSegmentPhysAddr :: Word64
elfSegmentPhysAddr = Word64
p_paddr
       , elfSegmentAlign :: Word64
elfSegmentAlign    = Word64
p_align
       , elfSegmentData :: ByteString
elfSegmentData     = Int -> ByteString -> ByteString
B.take (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
p_filesz) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
B.drop (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
p_offset) ByteString
elf_file
       , elfSegmentMemSize :: Word64
elfSegmentMemSize  = Word64
p_memsz
       }

data ElfSegmentFlag
  = PF_X        -- ^ Execute permission
  | PF_W        -- ^ Write permission
  | PF_R        -- ^ Read permission
  | PF_Ext Int  -- ^ Some other flag, the Int is the bit number for the flag.
    deriving (ElfSegmentFlag -> ElfSegmentFlag -> Bool
(ElfSegmentFlag -> ElfSegmentFlag -> Bool)
-> (ElfSegmentFlag -> ElfSegmentFlag -> Bool) -> Eq ElfSegmentFlag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfSegmentFlag -> ElfSegmentFlag -> Bool
$c/= :: ElfSegmentFlag -> ElfSegmentFlag -> Bool
== :: ElfSegmentFlag -> ElfSegmentFlag -> Bool
$c== :: ElfSegmentFlag -> ElfSegmentFlag -> Bool
Eq,Int -> ElfSegmentFlag -> ShowS
[ElfSegmentFlag] -> ShowS
ElfSegmentFlag -> String
(Int -> ElfSegmentFlag -> ShowS)
-> (ElfSegmentFlag -> String)
-> ([ElfSegmentFlag] -> ShowS)
-> Show ElfSegmentFlag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfSegmentFlag] -> ShowS
$cshowList :: [ElfSegmentFlag] -> ShowS
show :: ElfSegmentFlag -> String
$cshow :: ElfSegmentFlag -> String
showsPrec :: Int -> ElfSegmentFlag -> ShowS
$cshowsPrec :: Int -> ElfSegmentFlag -> ShowS
Show)

parseElfSegmentFlags :: Word32 -> [ElfSegmentFlag]
parseElfSegmentFlags :: Word32 -> [ElfSegmentFlag]
parseElfSegmentFlags Word32
word = [ Int -> ElfSegmentFlag
cvt Int
bit_ | Int
bit_ <- [ Int
0 .. Int
31 ], Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
word Int
bit_ ]
  where cvt :: Int -> ElfSegmentFlag
cvt Int
0 = ElfSegmentFlag
PF_X
        cvt Int
1 = ElfSegmentFlag
PF_W
        cvt Int
2 = ElfSegmentFlag
PF_R
        cvt Int
n = Int -> ElfSegmentFlag
PF_Ext Int
n

-- | The symbol table entries consist of index information to be read from other
-- parts of the ELF file. Some of this information is automatically retrieved
-- for your convenience (including symbol name, description of the enclosing
-- section, and definition).
data ElfSymbolTableEntry = EST
    { ElfSymbolTableEntry -> (Word32, Maybe ByteString)
steName             :: (Word32,Maybe B.ByteString)
    , ElfSymbolTableEntry -> Maybe ElfSection
steEnclosingSection :: Maybe ElfSection -- ^ Section from steIndex
    , ElfSymbolTableEntry -> ElfSymbolType
steType             :: ElfSymbolType
    , ElfSymbolTableEntry -> ElfSymbolBinding
steBind             :: ElfSymbolBinding
    , ElfSymbolTableEntry -> Word8
steOther            :: Word8
    , ElfSymbolTableEntry -> ElfSectionIndex
steIndex            :: ElfSectionIndex  -- ^ Section in which the def is held
    , ElfSymbolTableEntry -> Word64
steValue            :: Word64
    , ElfSymbolTableEntry -> Word64
steSize             :: Word64
    } deriving (ElfSymbolTableEntry -> ElfSymbolTableEntry -> Bool
(ElfSymbolTableEntry -> ElfSymbolTableEntry -> Bool)
-> (ElfSymbolTableEntry -> ElfSymbolTableEntry -> Bool)
-> Eq ElfSymbolTableEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfSymbolTableEntry -> ElfSymbolTableEntry -> Bool
$c/= :: ElfSymbolTableEntry -> ElfSymbolTableEntry -> Bool
== :: ElfSymbolTableEntry -> ElfSymbolTableEntry -> Bool
$c== :: ElfSymbolTableEntry -> ElfSymbolTableEntry -> Bool
Eq, Int -> ElfSymbolTableEntry -> ShowS
[ElfSymbolTableEntry] -> ShowS
ElfSymbolTableEntry -> String
(Int -> ElfSymbolTableEntry -> ShowS)
-> (ElfSymbolTableEntry -> String)
-> ([ElfSymbolTableEntry] -> ShowS)
-> Show ElfSymbolTableEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfSymbolTableEntry] -> ShowS
$cshowList :: [ElfSymbolTableEntry] -> ShowS
show :: ElfSymbolTableEntry -> String
$cshow :: ElfSymbolTableEntry -> String
showsPrec :: Int -> ElfSymbolTableEntry -> ShowS
$cshowsPrec :: Int -> ElfSymbolTableEntry -> ShowS
Show)

-- | Parse the symbol table section into a list of symbol table entries. If
-- no symbol table is found then an empty list is returned.
-- This function does not consult flags to look for SHT_STRTAB (when naming symbols),
-- it just looks for particular sections of ".strtab" and ".shstrtab".
parseSymbolTables :: Elf -> [[ElfSymbolTableEntry]]
parseSymbolTables :: Elf -> [[ElfSymbolTableEntry]]
parseSymbolTables Elf
e =
    let secs :: [ElfSection]
secs = Elf -> [ElfSection]
symbolTableSections Elf
e
    in (ElfSection -> [ElfSymbolTableEntry])
-> [ElfSection] -> [[ElfSymbolTableEntry]]
forall a b. (a -> b) -> [a] -> [b]
map (Elf -> ElfSection -> [ElfSymbolTableEntry]
getSymbolTableEntries Elf
e) [ElfSection]
secs

-- | Assumes the given section is a symbol table, type SHT_SYMTAB, or SHT_DYNSYM
-- (guaranteed by parseSymbolTables).
getSymbolTableEntries :: Elf -> ElfSection -> [ElfSymbolTableEntry]
getSymbolTableEntries :: Elf -> ElfSection -> [ElfSymbolTableEntry]
getSymbolTableEntries Elf
e ElfSection
s =
    Get ElfSymbolTableEntry -> ByteString -> [ElfSymbolTableEntry]
forall a. Get a -> ByteString -> [a]
decodeMany (Elf -> Maybe ElfSection -> Get ElfSymbolTableEntry
getSymbolTableEntry Elf
e Maybe ElfSection
strtab) (ByteString -> ByteString
L.fromStrict (ElfSection -> ByteString
elfSectionData ElfSection
s))
  where
    link :: Word32
link   = ElfSection -> Word32
elfSectionLink ElfSection
s
    strtab :: Maybe ElfSection
strtab = Integer -> [(Integer, ElfSection)] -> Maybe ElfSection
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
link) ([Integer] -> [ElfSection] -> [(Integer, ElfSection)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0..] (Elf -> [ElfSection]
elfSections Elf
e))

decodeMany :: forall a. Get a -> L.ByteString -> [a]
decodeMany :: Get a -> ByteString -> [a]
decodeMany Get a
get = Decoder a -> ByteString -> [a]
go Decoder a
decoder
  where
    decoder :: Decoder a
decoder = Get a -> Decoder a
forall a. Get a -> Decoder a
runGetIncremental Get a
get

    go :: Decoder a -> L.ByteString -> [a]
    go :: Decoder a -> ByteString -> [a]
go (Done ByteString
leftover ByteOffset
_ a
entry) ByteString
input =
      a
entry a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Decoder a -> ByteString -> [a]
go Decoder a
decoder (ByteString -> ByteString -> ByteString
L.Chunk ByteString
leftover ByteString
input)
    go (Partial Maybe ByteString -> Decoder a
k) ByteString
input =
      Decoder a -> ByteString -> [a]
go (Maybe ByteString -> Decoder a
k (Maybe ByteString -> Decoder a)
-> (ByteString -> Maybe ByteString) -> ByteString -> Decoder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe ByteString
takeHeadChunk (ByteString -> Decoder a) -> ByteString -> Decoder a
forall a b. (a -> b) -> a -> b
$ ByteString
input) (ByteString -> ByteString
dropHeadChunk ByteString
input)
    go (Fail ByteString
_ ByteOffset
_ String
msg) ByteString
input = if ByteString -> Bool
L.null ByteString
input
                              then []
                              else String -> [a]
forall a. HasCallStack => String -> a
error String
msg

takeHeadChunk :: L.ByteString -> Maybe B.ByteString
takeHeadChunk :: ByteString -> Maybe ByteString
takeHeadChunk ByteString
lbs =
  case ByteString
lbs of
    (L.Chunk ByteString
bs ByteString
_) -> ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs
    ByteString
_ -> Maybe ByteString
forall a. Maybe a
Nothing

dropHeadChunk :: L.ByteString -> L.ByteString
dropHeadChunk :: ByteString -> ByteString
dropHeadChunk ByteString
lbs =
  case ByteString
lbs of
    (L.Chunk ByteString
_ ByteString
lbs') -> ByteString
lbs'
    ByteString
_ -> ByteString
L.Empty


-- | Use the symbol offset and size to extract its definition
-- (in the form of a ByteString).
-- If the size is zero, or the offset larger than the 'elfSectionData',
-- then 'Nothing' is returned.
findSymbolDefinition :: ElfSymbolTableEntry -> Maybe B.ByteString
findSymbolDefinition :: ElfSymbolTableEntry -> Maybe ByteString
findSymbolDefinition ElfSymbolTableEntry
e = ElfSymbolTableEntry -> Maybe ElfSection
steEnclosingSection ElfSymbolTableEntry
e Maybe ElfSection
-> (ElfSection -> Maybe ByteString) -> Maybe ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ElfSection
enclosingSection ->
    let enclosingData :: ByteString
enclosingData = ElfSection -> ByteString
elfSectionData ElfSection
enclosingSection
        start :: Int
start = (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ElfSymbolTableEntry -> Word64
steValue ElfSymbolTableEntry
e)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ElfSection -> Word64
elfSectionAddr ElfSection
enclosingSection))
        len :: Int
len = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ElfSymbolTableEntry -> Word64
steSize ElfSymbolTableEntry
e)
        def :: ByteString
def = (Int -> ByteString -> ByteString
B.take Int
len (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop Int
start) ByteString
enclosingData
    in if ByteString -> Bool
B.null ByteString
def then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
def

symbolTableSections :: Elf -> [ElfSection]
symbolTableSections :: Elf -> [ElfSection]
symbolTableSections Elf
e = (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ElfSectionType -> [ElfSectionType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ElfSectionType
SHT_SYMTAB, ElfSectionType
SHT_DYNSYM]) (ElfSectionType -> Bool)
-> (ElfSection -> ElfSectionType) -> ElfSection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfSection -> ElfSectionType
elfSectionType) (Elf -> [ElfSection]
elfSections Elf
e)

-- | Gets a single entry from the symbol table, use with runGetMany.
getSymbolTableEntry :: Elf -> Maybe ElfSection -> Get ElfSymbolTableEntry
getSymbolTableEntry :: Elf -> Maybe ElfSection -> Get ElfSymbolTableEntry
getSymbolTableEntry Elf
e Maybe ElfSection
strtlb =
    if Elf -> ElfClass
elfClass Elf
e ElfClass -> ElfClass -> Bool
forall a. Eq a => a -> a -> Bool
== ElfClass
ELFCLASS32 then Get ElfSymbolTableEntry
getSymbolTableEntry32 else Get ElfSymbolTableEntry
getSymbolTableEntry64
  where
  strs :: ByteString
strs = ByteString
-> (ElfSection -> ByteString) -> Maybe ElfSection -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
B.empty ElfSection -> ByteString
elfSectionData Maybe ElfSection
strtlb
  er :: ElfReader
er = ElfData -> ElfReader
elfReader (Elf -> ElfData
elfData Elf
e)
  getSymbolTableEntry32 :: Get ElfSymbolTableEntry
getSymbolTableEntry32 = do
    Word32
nameIdx <- (Word32 -> Word32) -> Get Word32 -> Get Word32
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ElfReader -> Get Word32
getWord32 ElfReader
er)
    Word64
value <- (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ElfReader -> Get Word32
getWord32 ElfReader
er)
    Word64
size  <- (Word32 -> Word64) -> Get Word32 -> Get Word64
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ElfReader -> Get Word32
getWord32 ElfReader
er)
    Word8
info  <- Get Word8
getWord8
    Word8
other <- Get Word8
getWord8
    ElfSectionIndex
sTlbIdx <- (Word16 -> ElfSectionIndex) -> Get Word16 -> Get ElfSectionIndex
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ElfSectionIndex
forall a. Enum a => Int -> a
toEnum (Int -> ElfSectionIndex)
-> (Word16 -> Int) -> Word16 -> ElfSectionIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (ElfReader -> Get Word16
getWord16 ElfReader
er)
    let name :: Maybe ByteString
name = Word32 -> ByteString -> Maybe ByteString
forall n. Integral n => n -> ByteString -> Maybe ByteString
stringByIndex Word32
nameIdx ByteString
strs
        (ElfSymbolType
typ,ElfSymbolBinding
bind) = Word8 -> (ElfSymbolType, ElfSymbolBinding)
infoToTypeAndBind Word8
info
        sec :: Maybe ElfSection
sec = Elf -> ElfSectionIndex -> Maybe ElfSection
sectionByIndex Elf
e ElfSectionIndex
sTlbIdx
    ElfSymbolTableEntry -> Get ElfSymbolTableEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfSymbolTableEntry -> Get ElfSymbolTableEntry)
-> ElfSymbolTableEntry -> Get ElfSymbolTableEntry
forall a b. (a -> b) -> a -> b
$ (Word32, Maybe ByteString)
-> Maybe ElfSection
-> ElfSymbolType
-> ElfSymbolBinding
-> Word8
-> ElfSectionIndex
-> Word64
-> Word64
-> ElfSymbolTableEntry
EST (Word32
nameIdx,Maybe ByteString
name) Maybe ElfSection
sec ElfSymbolType
typ ElfSymbolBinding
bind Word8
other ElfSectionIndex
sTlbIdx Word64
value Word64
size
  getSymbolTableEntry64 :: Get ElfSymbolTableEntry
getSymbolTableEntry64 = do
    Word32
nameIdx <- (Word32 -> Word32) -> Get Word32 -> Get Word32
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Word32 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ElfReader -> Get Word32
getWord32 ElfReader
er)
    Word8
info <- Get Word8
getWord8
    Word8
other <- Get Word8
getWord8
    ElfSectionIndex
sTlbIdx <- (Word16 -> ElfSectionIndex) -> Get Word16 -> Get ElfSectionIndex
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ElfSectionIndex
forall a. Enum a => Int -> a
toEnum (Int -> ElfSectionIndex)
-> (Word16 -> Int) -> Word16 -> ElfSectionIndex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (ElfReader -> Get Word16
getWord16 ElfReader
er)
    Word64
symVal <- ElfReader -> Get Word64
getWord64 ElfReader
er
    Word64
size <- ElfReader -> Get Word64
getWord64 ElfReader
er
    let name :: Maybe ByteString
name = Word32 -> ByteString -> Maybe ByteString
forall n. Integral n => n -> ByteString -> Maybe ByteString
stringByIndex Word32
nameIdx ByteString
strs
        (ElfSymbolType
typ,ElfSymbolBinding
bind) = Word8 -> (ElfSymbolType, ElfSymbolBinding)
infoToTypeAndBind Word8
info
        sec :: Maybe ElfSection
sec = Elf -> ElfSectionIndex -> Maybe ElfSection
sectionByIndex Elf
e ElfSectionIndex
sTlbIdx
    ElfSymbolTableEntry -> Get ElfSymbolTableEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (ElfSymbolTableEntry -> Get ElfSymbolTableEntry)
-> ElfSymbolTableEntry -> Get ElfSymbolTableEntry
forall a b. (a -> b) -> a -> b
$ (Word32, Maybe ByteString)
-> Maybe ElfSection
-> ElfSymbolType
-> ElfSymbolBinding
-> Word8
-> ElfSectionIndex
-> Word64
-> Word64
-> ElfSymbolTableEntry
EST (Word32
nameIdx,Maybe ByteString
name) Maybe ElfSection
sec ElfSymbolType
typ ElfSymbolBinding
bind Word8
other ElfSectionIndex
sTlbIdx Word64
symVal Word64
size

sectionByIndex :: Elf -> ElfSectionIndex -> Maybe ElfSection
sectionByIndex :: Elf -> ElfSectionIndex -> Maybe ElfSection
sectionByIndex Elf
e (SHNIndex Word64
i) = Word64 -> [(Word64, ElfSection)] -> Maybe ElfSection
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Word64
i ([(Word64, ElfSection)] -> Maybe ElfSection)
-> ([ElfSection] -> [(Word64, ElfSection)])
-> [ElfSection]
-> Maybe ElfSection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word64] -> [ElfSection] -> [(Word64, ElfSection)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word64
0..] ([ElfSection] -> Maybe ElfSection)
-> [ElfSection] -> Maybe ElfSection
forall a b. (a -> b) -> a -> b
$ Elf -> [ElfSection]
elfSections Elf
e
sectionByIndex Elf
_ ElfSectionIndex
_ = Maybe ElfSection
forall a. Maybe a
Nothing

infoToTypeAndBind :: Word8 -> (ElfSymbolType,ElfSymbolBinding)
infoToTypeAndBind :: Word8 -> (ElfSymbolType, ElfSymbolBinding)
infoToTypeAndBind Word8
i =
    let t :: Int
t = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Word8
i Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0x0F
        b :: Int
b = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ (Word8
i Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xF0) Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`shiftR` Int
4
    in (Int -> ElfSymbolType
forall a. Enum a => Int -> a
toEnum Int
t, Int -> ElfSymbolBinding
forall a. Enum a => Int -> a
toEnum Int
b)

data ElfSymbolBinding
    = STBLocal
    | STBGlobal
    | STBWeak
    | STBLoOS
    | STBHiOS
    | STBLoProc
    | STBHiProc
    deriving (ElfSymbolBinding -> ElfSymbolBinding -> Bool
(ElfSymbolBinding -> ElfSymbolBinding -> Bool)
-> (ElfSymbolBinding -> ElfSymbolBinding -> Bool)
-> Eq ElfSymbolBinding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
$c/= :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
== :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
$c== :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
Eq, Eq ElfSymbolBinding
Eq ElfSymbolBinding
-> (ElfSymbolBinding -> ElfSymbolBinding -> Ordering)
-> (ElfSymbolBinding -> ElfSymbolBinding -> Bool)
-> (ElfSymbolBinding -> ElfSymbolBinding -> Bool)
-> (ElfSymbolBinding -> ElfSymbolBinding -> Bool)
-> (ElfSymbolBinding -> ElfSymbolBinding -> Bool)
-> (ElfSymbolBinding -> ElfSymbolBinding -> ElfSymbolBinding)
-> (ElfSymbolBinding -> ElfSymbolBinding -> ElfSymbolBinding)
-> Ord ElfSymbolBinding
ElfSymbolBinding -> ElfSymbolBinding -> Bool
ElfSymbolBinding -> ElfSymbolBinding -> Ordering
ElfSymbolBinding -> ElfSymbolBinding -> ElfSymbolBinding
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 :: ElfSymbolBinding -> ElfSymbolBinding -> ElfSymbolBinding
$cmin :: ElfSymbolBinding -> ElfSymbolBinding -> ElfSymbolBinding
max :: ElfSymbolBinding -> ElfSymbolBinding -> ElfSymbolBinding
$cmax :: ElfSymbolBinding -> ElfSymbolBinding -> ElfSymbolBinding
>= :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
$c>= :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
> :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
$c> :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
<= :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
$c<= :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
< :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
$c< :: ElfSymbolBinding -> ElfSymbolBinding -> Bool
compare :: ElfSymbolBinding -> ElfSymbolBinding -> Ordering
$ccompare :: ElfSymbolBinding -> ElfSymbolBinding -> Ordering
$cp1Ord :: Eq ElfSymbolBinding
Ord, Int -> ElfSymbolBinding -> ShowS
[ElfSymbolBinding] -> ShowS
ElfSymbolBinding -> String
(Int -> ElfSymbolBinding -> ShowS)
-> (ElfSymbolBinding -> String)
-> ([ElfSymbolBinding] -> ShowS)
-> Show ElfSymbolBinding
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfSymbolBinding] -> ShowS
$cshowList :: [ElfSymbolBinding] -> ShowS
show :: ElfSymbolBinding -> String
$cshow :: ElfSymbolBinding -> String
showsPrec :: Int -> ElfSymbolBinding -> ShowS
$cshowsPrec :: Int -> ElfSymbolBinding -> ShowS
Show, ReadPrec [ElfSymbolBinding]
ReadPrec ElfSymbolBinding
Int -> ReadS ElfSymbolBinding
ReadS [ElfSymbolBinding]
(Int -> ReadS ElfSymbolBinding)
-> ReadS [ElfSymbolBinding]
-> ReadPrec ElfSymbolBinding
-> ReadPrec [ElfSymbolBinding]
-> Read ElfSymbolBinding
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ElfSymbolBinding]
$creadListPrec :: ReadPrec [ElfSymbolBinding]
readPrec :: ReadPrec ElfSymbolBinding
$creadPrec :: ReadPrec ElfSymbolBinding
readList :: ReadS [ElfSymbolBinding]
$creadList :: ReadS [ElfSymbolBinding]
readsPrec :: Int -> ReadS ElfSymbolBinding
$creadsPrec :: Int -> ReadS ElfSymbolBinding
Read)

instance Enum ElfSymbolBinding where
    fromEnum :: ElfSymbolBinding -> Int
fromEnum ElfSymbolBinding
STBLocal  = Int
0
    fromEnum ElfSymbolBinding
STBGlobal = Int
1
    fromEnum ElfSymbolBinding
STBWeak   = Int
2
    fromEnum ElfSymbolBinding
STBLoOS   = Int
10
    fromEnum ElfSymbolBinding
STBHiOS   = Int
12
    fromEnum ElfSymbolBinding
STBLoProc = Int
13
    fromEnum ElfSymbolBinding
STBHiProc = Int
15
    toEnum :: Int -> ElfSymbolBinding
toEnum  Int
0 = ElfSymbolBinding
STBLocal
    toEnum  Int
1 = ElfSymbolBinding
STBGlobal
    toEnum  Int
2 = ElfSymbolBinding
STBWeak
    toEnum Int
10 = ElfSymbolBinding
STBLoOS
    toEnum Int
12 = ElfSymbolBinding
STBHiOS
    toEnum Int
13 = ElfSymbolBinding
STBLoProc
    toEnum Int
15 = ElfSymbolBinding
STBHiProc

data ElfSymbolType
    = STTNoType
    | STTObject
    | STTFunc
    | STTSection
    | STTFile
    | STTCommon
    | STTTLS
    | STTLoOS
    | STTHiOS
    | STTLoProc
    | STTHiProc
    deriving (ElfSymbolType -> ElfSymbolType -> Bool
(ElfSymbolType -> ElfSymbolType -> Bool)
-> (ElfSymbolType -> ElfSymbolType -> Bool) -> Eq ElfSymbolType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfSymbolType -> ElfSymbolType -> Bool
$c/= :: ElfSymbolType -> ElfSymbolType -> Bool
== :: ElfSymbolType -> ElfSymbolType -> Bool
$c== :: ElfSymbolType -> ElfSymbolType -> Bool
Eq, Eq ElfSymbolType
Eq ElfSymbolType
-> (ElfSymbolType -> ElfSymbolType -> Ordering)
-> (ElfSymbolType -> ElfSymbolType -> Bool)
-> (ElfSymbolType -> ElfSymbolType -> Bool)
-> (ElfSymbolType -> ElfSymbolType -> Bool)
-> (ElfSymbolType -> ElfSymbolType -> Bool)
-> (ElfSymbolType -> ElfSymbolType -> ElfSymbolType)
-> (ElfSymbolType -> ElfSymbolType -> ElfSymbolType)
-> Ord ElfSymbolType
ElfSymbolType -> ElfSymbolType -> Bool
ElfSymbolType -> ElfSymbolType -> Ordering
ElfSymbolType -> ElfSymbolType -> ElfSymbolType
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 :: ElfSymbolType -> ElfSymbolType -> ElfSymbolType
$cmin :: ElfSymbolType -> ElfSymbolType -> ElfSymbolType
max :: ElfSymbolType -> ElfSymbolType -> ElfSymbolType
$cmax :: ElfSymbolType -> ElfSymbolType -> ElfSymbolType
>= :: ElfSymbolType -> ElfSymbolType -> Bool
$c>= :: ElfSymbolType -> ElfSymbolType -> Bool
> :: ElfSymbolType -> ElfSymbolType -> Bool
$c> :: ElfSymbolType -> ElfSymbolType -> Bool
<= :: ElfSymbolType -> ElfSymbolType -> Bool
$c<= :: ElfSymbolType -> ElfSymbolType -> Bool
< :: ElfSymbolType -> ElfSymbolType -> Bool
$c< :: ElfSymbolType -> ElfSymbolType -> Bool
compare :: ElfSymbolType -> ElfSymbolType -> Ordering
$ccompare :: ElfSymbolType -> ElfSymbolType -> Ordering
$cp1Ord :: Eq ElfSymbolType
Ord, Int -> ElfSymbolType -> ShowS
[ElfSymbolType] -> ShowS
ElfSymbolType -> String
(Int -> ElfSymbolType -> ShowS)
-> (ElfSymbolType -> String)
-> ([ElfSymbolType] -> ShowS)
-> Show ElfSymbolType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfSymbolType] -> ShowS
$cshowList :: [ElfSymbolType] -> ShowS
show :: ElfSymbolType -> String
$cshow :: ElfSymbolType -> String
showsPrec :: Int -> ElfSymbolType -> ShowS
$cshowsPrec :: Int -> ElfSymbolType -> ShowS
Show, ReadPrec [ElfSymbolType]
ReadPrec ElfSymbolType
Int -> ReadS ElfSymbolType
ReadS [ElfSymbolType]
(Int -> ReadS ElfSymbolType)
-> ReadS [ElfSymbolType]
-> ReadPrec ElfSymbolType
-> ReadPrec [ElfSymbolType]
-> Read ElfSymbolType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ElfSymbolType]
$creadListPrec :: ReadPrec [ElfSymbolType]
readPrec :: ReadPrec ElfSymbolType
$creadPrec :: ReadPrec ElfSymbolType
readList :: ReadS [ElfSymbolType]
$creadList :: ReadS [ElfSymbolType]
readsPrec :: Int -> ReadS ElfSymbolType
$creadsPrec :: Int -> ReadS ElfSymbolType
Read)

instance Enum ElfSymbolType where
    fromEnum :: ElfSymbolType -> Int
fromEnum ElfSymbolType
STTNoType  = Int
0
    fromEnum ElfSymbolType
STTObject  = Int
1
    fromEnum ElfSymbolType
STTFunc    = Int
2
    fromEnum ElfSymbolType
STTSection = Int
3
    fromEnum ElfSymbolType
STTFile    = Int
4
    fromEnum ElfSymbolType
STTCommon  = Int
5
    fromEnum ElfSymbolType
STTTLS     = Int
6
    fromEnum ElfSymbolType
STTLoOS    = Int
10
    fromEnum ElfSymbolType
STTHiOS    = Int
12
    fromEnum ElfSymbolType
STTLoProc  = Int
13
    fromEnum ElfSymbolType
STTHiProc  = Int
15
    toEnum :: Int -> ElfSymbolType
toEnum  Int
0 = ElfSymbolType
STTNoType
    toEnum  Int
1 = ElfSymbolType
STTObject
    toEnum  Int
2 = ElfSymbolType
STTFunc
    toEnum  Int
3 = ElfSymbolType
STTSection
    toEnum  Int
4 = ElfSymbolType
STTFile
    toEnum  Int
5 = ElfSymbolType
STTCommon
    toEnum  Int
6 = ElfSymbolType
STTTLS
    toEnum Int
10 = ElfSymbolType
STTLoOS
    toEnum Int
12 = ElfSymbolType
STTHiOS
    toEnum Int
13 = ElfSymbolType
STTLoProc
    toEnum Int
15 = ElfSymbolType
STTHiProc

data ElfSectionIndex
    = SHNUndef
    | SHNLoProc
    | SHNCustomProc Word64
    | SHNHiProc
    | SHNLoOS
    | SHNCustomOS Word64
    | SHNHiOS
    | SHNAbs
    | SHNCommon
    | SHNIndex Word64
    deriving (ElfSectionIndex -> ElfSectionIndex -> Bool
(ElfSectionIndex -> ElfSectionIndex -> Bool)
-> (ElfSectionIndex -> ElfSectionIndex -> Bool)
-> Eq ElfSectionIndex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfSectionIndex -> ElfSectionIndex -> Bool
$c/= :: ElfSectionIndex -> ElfSectionIndex -> Bool
== :: ElfSectionIndex -> ElfSectionIndex -> Bool
$c== :: ElfSectionIndex -> ElfSectionIndex -> Bool
Eq, Eq ElfSectionIndex
Eq ElfSectionIndex
-> (ElfSectionIndex -> ElfSectionIndex -> Ordering)
-> (ElfSectionIndex -> ElfSectionIndex -> Bool)
-> (ElfSectionIndex -> ElfSectionIndex -> Bool)
-> (ElfSectionIndex -> ElfSectionIndex -> Bool)
-> (ElfSectionIndex -> ElfSectionIndex -> Bool)
-> (ElfSectionIndex -> ElfSectionIndex -> ElfSectionIndex)
-> (ElfSectionIndex -> ElfSectionIndex -> ElfSectionIndex)
-> Ord ElfSectionIndex
ElfSectionIndex -> ElfSectionIndex -> Bool
ElfSectionIndex -> ElfSectionIndex -> Ordering
ElfSectionIndex -> ElfSectionIndex -> ElfSectionIndex
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 :: ElfSectionIndex -> ElfSectionIndex -> ElfSectionIndex
$cmin :: ElfSectionIndex -> ElfSectionIndex -> ElfSectionIndex
max :: ElfSectionIndex -> ElfSectionIndex -> ElfSectionIndex
$cmax :: ElfSectionIndex -> ElfSectionIndex -> ElfSectionIndex
>= :: ElfSectionIndex -> ElfSectionIndex -> Bool
$c>= :: ElfSectionIndex -> ElfSectionIndex -> Bool
> :: ElfSectionIndex -> ElfSectionIndex -> Bool
$c> :: ElfSectionIndex -> ElfSectionIndex -> Bool
<= :: ElfSectionIndex -> ElfSectionIndex -> Bool
$c<= :: ElfSectionIndex -> ElfSectionIndex -> Bool
< :: ElfSectionIndex -> ElfSectionIndex -> Bool
$c< :: ElfSectionIndex -> ElfSectionIndex -> Bool
compare :: ElfSectionIndex -> ElfSectionIndex -> Ordering
$ccompare :: ElfSectionIndex -> ElfSectionIndex -> Ordering
$cp1Ord :: Eq ElfSectionIndex
Ord, Int -> ElfSectionIndex -> ShowS
[ElfSectionIndex] -> ShowS
ElfSectionIndex -> String
(Int -> ElfSectionIndex -> ShowS)
-> (ElfSectionIndex -> String)
-> ([ElfSectionIndex] -> ShowS)
-> Show ElfSectionIndex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfSectionIndex] -> ShowS
$cshowList :: [ElfSectionIndex] -> ShowS
show :: ElfSectionIndex -> String
$cshow :: ElfSectionIndex -> String
showsPrec :: Int -> ElfSectionIndex -> ShowS
$cshowsPrec :: Int -> ElfSectionIndex -> ShowS
Show, ReadPrec [ElfSectionIndex]
ReadPrec ElfSectionIndex
Int -> ReadS ElfSectionIndex
ReadS [ElfSectionIndex]
(Int -> ReadS ElfSectionIndex)
-> ReadS [ElfSectionIndex]
-> ReadPrec ElfSectionIndex
-> ReadPrec [ElfSectionIndex]
-> Read ElfSectionIndex
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ElfSectionIndex]
$creadListPrec :: ReadPrec [ElfSectionIndex]
readPrec :: ReadPrec ElfSectionIndex
$creadPrec :: ReadPrec ElfSectionIndex
readList :: ReadS [ElfSectionIndex]
$creadList :: ReadS [ElfSectionIndex]
readsPrec :: Int -> ReadS ElfSectionIndex
$creadsPrec :: Int -> ReadS ElfSectionIndex
Read)

instance Enum ElfSectionIndex where
    fromEnum :: ElfSectionIndex -> Int
fromEnum ElfSectionIndex
SHNUndef = Int
0
    fromEnum ElfSectionIndex
SHNLoProc = Int
0xFF00
    fromEnum ElfSectionIndex
SHNHiProc = Int
0xFF1F
    fromEnum ElfSectionIndex
SHNLoOS   = Int
0xFF20
    fromEnum ElfSectionIndex
SHNHiOS   = Int
0xFF3F
    fromEnum ElfSectionIndex
SHNAbs    = Int
0xFFF1
    fromEnum ElfSectionIndex
SHNCommon = Int
0xFFF2
    fromEnum (SHNCustomProc Word64
x) = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x
    fromEnum (SHNCustomOS Word64
x) = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x
    fromEnum (SHNIndex Word64
x) = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
x
    toEnum :: Int -> ElfSectionIndex
toEnum Int
0 = ElfSectionIndex
SHNUndef
    toEnum Int
0xff00 = ElfSectionIndex
SHNLoProc
    toEnum Int
0xFF1F = ElfSectionIndex
SHNHiProc
    toEnum Int
0xFF20 = ElfSectionIndex
SHNLoOS
    toEnum Int
0xFF3F = ElfSectionIndex
SHNHiOS
    toEnum Int
0xFFF1 = ElfSectionIndex
SHNAbs
    toEnum Int
0xFFF2 = ElfSectionIndex
SHNCommon
    toEnum Int
x
        | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ElfSectionIndex -> Int
forall a. Enum a => a -> Int
fromEnum ElfSectionIndex
SHNLoProc Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ElfSectionIndex -> Int
forall a. Enum a => a -> Int
fromEnum ElfSectionIndex
SHNHiProc = Word64 -> ElfSectionIndex
SHNCustomProc (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
        | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ElfSectionIndex -> Int
forall a. Enum a => a -> Int
fromEnum ElfSectionIndex
SHNLoOS Bool -> Bool -> Bool
&& Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ElfSectionIndex -> Int
forall a. Enum a => a -> Int
fromEnum ElfSectionIndex
SHNHiOS = Word64 -> ElfSectionIndex
SHNCustomOS (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
        | Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ElfSectionIndex -> Int
forall a. Enum a => a -> Int
fromEnum ElfSectionIndex
SHNLoProc Bool -> Bool -> Bool
|| Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0xFFFF = Word64 -> ElfSectionIndex
SHNIndex (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
x)
        | Bool
otherwise = String -> ElfSectionIndex
forall a. HasCallStack => String -> a
error String
"Section index number is in a reserved range but we don't recognize the value from any standard."

-- | Given a section name, extract the ElfSection.
findSectionByName :: String -> Elf -> Maybe ElfSection
findSectionByName :: String -> Elf -> Maybe ElfSection
findSectionByName String
name = [ElfSection] -> Maybe ElfSection
forall a. [a] -> Maybe a
listToMaybe ([ElfSection] -> Maybe ElfSection)
-> (Elf -> [ElfSection]) -> Elf -> Maybe ElfSection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ElfSection -> Bool) -> [ElfSection] -> [ElfSection]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) String
name (String -> Bool) -> (ElfSection -> String) -> ElfSection -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ElfSection -> String
elfSectionName) ([ElfSection] -> [ElfSection])
-> (Elf -> [ElfSection]) -> Elf -> [ElfSection]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Elf -> [ElfSection]
elfSections

-- Get a string from a strtab ByteString.
stringByIndex :: Integral n => n -> B.ByteString -> Maybe B.ByteString
stringByIndex :: n -> ByteString -> Maybe ByteString
stringByIndex n
n ByteString
strtab =
    let str :: ByteString
str = ((Word8 -> Bool) -> ByteString -> ByteString
B.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/=Word8
0) (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
B.drop (n -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral n
n)) ByteString
strtab
    in if ByteString -> Int
B.length ByteString
str Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
str

data ElfRel = ElfRel
    { ElfRel -> Word64
elfRelOffset    :: Word64
    , ElfRel -> Word64
elfRelSymbol    :: Word64
    , ElfRel -> Word8
elfRelType      :: Word8
    , ElfRel -> Maybe ByteOffset
elfRelSymAddend :: Maybe Int64
    } deriving (ElfRel -> ElfRel -> Bool
(ElfRel -> ElfRel -> Bool)
-> (ElfRel -> ElfRel -> Bool) -> Eq ElfRel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfRel -> ElfRel -> Bool
$c/= :: ElfRel -> ElfRel -> Bool
== :: ElfRel -> ElfRel -> Bool
$c== :: ElfRel -> ElfRel -> Bool
Eq, Int -> ElfRel -> ShowS
[ElfRel] -> ShowS
ElfRel -> String
(Int -> ElfRel -> ShowS)
-> (ElfRel -> String) -> ([ElfRel] -> ShowS) -> Show ElfRel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfRel] -> ShowS
$cshowList :: [ElfRel] -> ShowS
show :: ElfRel -> String
$cshow :: ElfRel -> String
showsPrec :: Int -> ElfRel -> ShowS
$cshowsPrec :: Int -> ElfRel -> ShowS
Show)

getElfRel :: ElfClass
          -> ElfReader
          -> Bool   -- ^ explicit addend?
          -> Get ElfRel
getElfRel :: ElfClass -> ElfReader -> Bool -> Get ElfRel
getElfRel ElfClass
ELFCLASS64 ElfReader
er Bool
explicit = do
    Word64
offset <- ElfReader -> Get Word64
getWord64 ElfReader
er
    Word64
info <- ElfReader -> Get Word64
getWord64 ElfReader
er
    Maybe Word64
addend <- if Bool
explicit then Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Word64 -> Maybe Word64) -> Get Word64 -> Get (Maybe Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElfReader -> Get Word64
getWord64 ElfReader
er else Maybe Word64 -> Get (Maybe Word64)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word64
forall a. Maybe a
Nothing
    ElfRel -> Get ElfRel
forall (m :: * -> *) a. Monad m => a -> m a
return ElfRel :: Word64 -> Word64 -> Word8 -> Maybe ByteOffset -> ElfRel
ElfRel { elfRelOffset :: Word64
elfRelOffset    = Word64
offset
                  , elfRelSymbol :: Word64
elfRelSymbol    = Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
info Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
32)
                  , elfRelType :: Word8
elfRelType      = Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
info
                  , elfRelSymAddend :: Maybe ByteOffset
elfRelSymAddend = Word64 -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> ByteOffset) -> Maybe Word64 -> Maybe ByteOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word64
addend
                  }
getElfRel ElfClass
ELFCLASS32 ElfReader
er Bool
explicit = do
    Word32
offset <- ElfReader -> Get Word32
getWord32 ElfReader
er
    Word32
info <- ElfReader -> Get Word32
getWord32 ElfReader
er
    Maybe Word32
addend <- if Bool
explicit then Word32 -> Maybe Word32
forall a. a -> Maybe a
Just (Word32 -> Maybe Word32) -> Get Word32 -> Get (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ElfReader -> Get Word32
getWord32 ElfReader
er else Maybe Word32 -> Get (Maybe Word32)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Word32
forall a. Maybe a
Nothing
    ElfRel -> Get ElfRel
forall (m :: * -> *) a. Monad m => a -> m a
return ElfRel :: Word64 -> Word64 -> Word8 -> Maybe ByteOffset -> ElfRel
ElfRel { elfRelOffset :: Word64
elfRelOffset    = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
offset
                  , elfRelSymbol :: Word64
elfRelSymbol    = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
info Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8)
                  , elfRelType :: Word8
elfRelType      = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
info
                  , elfRelSymAddend :: Maybe ByteOffset
elfRelSymAddend = Word32 -> ByteOffset
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> ByteOffset) -> Maybe Word32 -> Maybe ByteOffset
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Word32
addend
                  }

getRelocations :: ElfClass -> ElfReader -> ElfSection -> [ElfRel]
getRelocations :: ElfClass -> ElfReader -> ElfSection -> [ElfRel]
getRelocations ElfClass
elf_class ElfReader
er ElfSection
s =
    Get ElfRel -> ByteString -> [ElfRel]
forall a. Get a -> ByteString -> [a]
decodeMany (ElfClass -> ElfReader -> Bool -> Get ElfRel
getElfRel ElfClass
elf_class ElfReader
er Bool
explicit) (ByteString -> ByteString
L.fromStrict (ElfSection -> ByteString
elfSectionData ElfSection
s))
  where
    explicit :: Bool
explicit = ElfSection -> ElfSectionType
elfSectionType ElfSection
s ElfSectionType -> ElfSectionType -> Bool
forall a. Eq a => a -> a -> Bool
== ElfSectionType
SHT_RELA

data ElfRelocationSection = ElfRelocationSection
    { ElfRelocationSection -> [ElfSymbolTableEntry]
elfRelSectSymbolTable :: [ElfSymbolTableEntry]
    , ElfRelocationSection -> ElfSection
elfRelSectRelocated   :: ElfSection
    , ElfRelocationSection -> [ElfRel]
elfRelSectRelocations :: [ElfRel]
    } deriving (ElfRelocationSection -> ElfRelocationSection -> Bool
(ElfRelocationSection -> ElfRelocationSection -> Bool)
-> (ElfRelocationSection -> ElfRelocationSection -> Bool)
-> Eq ElfRelocationSection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ElfRelocationSection -> ElfRelocationSection -> Bool
$c/= :: ElfRelocationSection -> ElfRelocationSection -> Bool
== :: ElfRelocationSection -> ElfRelocationSection -> Bool
$c== :: ElfRelocationSection -> ElfRelocationSection -> Bool
Eq, Int -> ElfRelocationSection -> ShowS
[ElfRelocationSection] -> ShowS
ElfRelocationSection -> String
(Int -> ElfRelocationSection -> ShowS)
-> (ElfRelocationSection -> String)
-> ([ElfRelocationSection] -> ShowS)
-> Show ElfRelocationSection
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElfRelocationSection] -> ShowS
$cshowList :: [ElfRelocationSection] -> ShowS
show :: ElfRelocationSection -> String
$cshow :: ElfRelocationSection -> String
showsPrec :: Int -> ElfRelocationSection -> ShowS
$cshowsPrec :: Int -> ElfRelocationSection -> ShowS
Show)

parseRelocations :: Elf -> [ElfRelocationSection]
parseRelocations :: Elf -> [ElfRelocationSection]
parseRelocations Elf
elf =
    [ ElfRelocationSection :: [ElfSymbolTableEntry]
-> ElfSection -> [ElfRel] -> ElfRelocationSection
ElfRelocationSection { elfRelSectSymbolTable :: [ElfSymbolTableEntry]
elfRelSectSymbolTable = [ElfSymbolTableEntry]
symtab
                           , elfRelSectRelocated :: ElfSection
elfRelSectRelocated   = ElfSection
relocated
                           , elfRelSectRelocations :: [ElfRel]
elfRelSectRelocations = [ElfRel]
rels
                           }
    | ElfSection
s <- Elf -> [ElfSection]
elfSections Elf
elf
    , ElfSection -> ElfSectionType
elfSectionType ElfSection
s ElfSectionType -> [ElfSectionType] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ElfSectionType
SHT_REL, ElfSectionType
SHT_RELA]
    , let symtab :: [ElfSymbolTableEntry]
symtab = Elf -> ElfSection -> [ElfSymbolTableEntry]
getSymbolTableEntries Elf
elf (Word32 -> ElfSection
forall a. Integral a => a -> ElfSection
getSection (ElfSection -> Word32
elfSectionLink ElfSection
s))
          relocated :: ElfSection
relocated = Word32 -> ElfSection
forall a. Integral a => a -> ElfSection
getSection (ElfSection -> Word32
elfSectionInfo ElfSection
s)
          rels :: [ElfRel]
rels = ElfClass -> ElfReader -> ElfSection -> [ElfRel]
getRelocations (Elf -> ElfClass
elfClass Elf
elf) ElfReader
er ElfSection
s
    ]
  where
    getSection :: a -> ElfSection
getSection a
i = Elf -> [ElfSection]
elfSections Elf
elf [ElfSection] -> Int -> ElfSection
forall a. [a] -> Int -> a
!! a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i
    er :: ElfReader
er = ElfData -> ElfReader
elfReader (Elf -> ElfData
elfData Elf
elf)