-- |
-- Module      : Data.ELF.Headers
-- Description : Parse headers and table entries of ELF files
-- Copyright   : (c) Aleksey Makarov, 2021
-- License     : BSD 3-Clause License
-- Maintainer  : aleksey.makarov@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- Parse headers and table entries of ELF files

{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE EmptyCase #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTSyntax #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

module Data.Elf.Headers (
    -- * Data definition
      elfMagic
    , ElfClass (..)
    , ElfData (..)

    -- * Singletons

    , SingElfClass (..)
    , SingElfClassI (..)
    , withSingElfClass
    , withSingElfClassI
    , fromSingElfClass
    , withElfClass

    -- * Types of ELF header
    , HeaderXX (..)
    , headerSize
    , Header (..)

    -- * Types of ELF tables

    -- ** Section table
    , SectionXX (..)
    , sectionTableEntrySize

    -- ** Segment table
    , SegmentXX (..)
    , segmentTableEntrySize

    -- ** Sybmol table
    , SymbolXX (..)
    , symbolTableEntrySize

    -- ** Relocation table
    , RelaXX (..)
    , relocationTableAEntrySize

    -- * Parse header and section and segment tables
    , Headers (..)
    , parseHeaders

    -- * Parse/serialize array of data

    -- | BList is an internal newtype for @[a]@ that is an instance of `Data.Binary.Binary`.
    -- When serializing, the @Binary@ instance for BList does not write the length of the array to the stream.
    -- Instead, parser just reads all the stream till the end.

    , parseBList
    , serializeBList

    -- * Misc helpers
    , sectionIsSymbolTable
    , getSectionData
    , getString
    , wordSize

    ) where

import Control.Monad
import Control.Monad.Catch
import Data.Binary
import Data.Binary.Get
import Data.Binary.Put
import Data.Bits
import Data.ByteString       as BS
import Data.ByteString.Lazy  as BSL
import Data.ByteString.Lazy.Char8 as BSL8
import Data.Data (Data)
import Data.Int
import Data.Kind
import qualified Data.List as L
import Data.Typeable (Typeable)

import Control.Exception.ChainedException
import Data.BList
import Data.Endian
import Data.Elf.Constants

-- | ELF class.  Tells if ELF defines 32- or 64-bit objects
data ElfClass
    = ELFCLASS32 -- ^ 32-bit ELF format
    | ELFCLASS64 -- ^ 64-bit ELF format
    deriving (ElfClass -> ElfClass -> Bool
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
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)

-- | Singletons for ElfClass
data SingElfClass :: ElfClass -> Type where
    SELFCLASS32 :: SingElfClass 'ELFCLASS32  -- ^ Singleton for `ELFCLASS32`
    SELFCLASS64 :: SingElfClass 'ELFCLASS64  -- ^ Singleton for `ELFCLASS64`

instance Binary ElfClass where
    get :: Get ElfClass
get = Get Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {m :: * -> *}.
(Eq a, Num a, MonadFail m) =>
a -> m ElfClass
getElfClass_
        where
            getElfClass_ :: a -> m ElfClass
getElfClass_ a
1 = forall (m :: * -> *) a. Monad m => a -> m a
return ElfClass
ELFCLASS32
            getElfClass_ a
2 = forall (m :: * -> *) a. Monad m => a -> m a
return ElfClass
ELFCLASS64
            getElfClass_ a
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ELF class"
    put :: ElfClass -> Put
put ElfClass
ELFCLASS32 = Word8 -> Put
putWord8 Word8
1
    put ElfClass
ELFCLASS64 = Word8 -> Put
putWord8 Word8
2

-- | ELF data. Specifies the endianness of the ELF data
data ElfData
    = ELFDATA2LSB -- ^ Little-endian ELF format
    | ELFDATA2MSB -- ^ Big-endian ELF format
    deriving (ElfData -> ElfData -> Bool
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
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)

instance Binary ElfData where
    get :: Get ElfData
get = Get Word8
getWord8 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a} {m :: * -> *}.
(Eq a, Num a, MonadFail m) =>
a -> m ElfData
getElfData_
        where
            getElfData_ :: a -> m ElfData
getElfData_ a
1 = forall (m :: * -> *) a. Monad m => a -> m a
return ElfData
ELFDATA2LSB
            getElfData_ a
2 = forall (m :: * -> *) a. Monad m => a -> m a
return ElfData
ELFDATA2MSB
            getElfData_ a
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ELF data"
    put :: ElfData -> Put
put ElfData
ELFDATA2LSB = Word8 -> Put
putWord8 Word8
1
    put ElfData
ELFDATA2MSB = Word8 -> Put
putWord8 Word8
2

elfSupportedVersion :: Word8
elfSupportedVersion :: Word8
elfSupportedVersion = Word8
1

-- at :: (Integral i) => [a] -> i -> Maybe a
-- at (x : _)  0             = Just x
-- at (_ : xs) n | n > 0     = xs `at` (n - 1)
--               | otherwise = Nothing
-- at _        _             = Nothing

-- nameToString :: Maybe BS.ByteString -> String
-- nameToString bs = maybe "" id $ BSC.unpack <$> bs

-- cut :: BS.ByteString -> Int -> Int -> BS.ByteString
-- cut content offset size = BS.take size $ BS.drop offset content

-- | The first 4 bytes of the ELF file
elfMagic :: Be Word32
elfMagic :: Be Word32
elfMagic = forall a. a -> Be a
Be Word32
0x7f454c46 -- "\DELELF"

verify :: (Binary a, Eq a) => String -> a -> Get ()
verify :: forall a. (Binary a, Eq a) => String -> a -> Get ()
verify String
msg a
orig = do
    a
a <- forall t. Binary t => Get t
get
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
orig forall a. Eq a => a -> a -> Bool
/= a
a) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error (String
"verification failed: " forall a. [a] -> [a] -> [a]
++ String
msg)

-- getTable :: (Binary (Le a), Binary (Be a)) => ElfData -> Word64 -> Word16 -> Word16 -> Get [a]
-- getTable endianness offset entrySize entryNumber = lookAhead $ do
--     skip $ fromIntegral offset
--     getTable' entryNumber
--     where
--         getTable' 0 = return []
--         getTable' n = do
--             a <- isolate (fromIntegral entrySize) $ getEndian endianness
--             (a :) <$> getTable' (n - 1)

getEndian :: (Binary (Le a), Binary (Be a)) => ElfData -> Get a
getEndian :: forall a. (Binary (Le a), Binary (Be a)) => ElfData -> Get a
getEndian ElfData
ELFDATA2LSB = forall a. Le a -> a
fromLe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get
getEndian ElfData
ELFDATA2MSB = forall a. Be a -> a
fromBe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Binary t => Get t
get

getBe :: (Binary (Le b), Binary (Be b)) => Get b
getBe :: forall b. (Binary (Le b), Binary (Be b)) => Get b
getBe = forall a. (Binary (Le a), Binary (Be a)) => ElfData -> Get a
getEndian ElfData
ELFDATA2MSB

getLe :: (Binary (Le b), Binary (Be b)) => Get b
getLe :: forall b. (Binary (Le b), Binary (Be b)) => Get b
getLe = forall a. (Binary (Le a), Binary (Be a)) => ElfData -> Get a
getEndian ElfData
ELFDATA2LSB

putEndian :: (Binary (Le a), Binary (Be a)) => ElfData -> a -> Put
putEndian :: forall a. (Binary (Le a), Binary (Be a)) => ElfData -> a -> Put
putEndian ElfData
ELFDATA2LSB = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Le a
Le
putEndian ElfData
ELFDATA2MSB = forall t. Binary t => t -> Put
put forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Be a
Be

putBe :: (Binary (Le b), Binary (Be b)) => b -> Put
putBe :: forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe = forall a. (Binary (Le a), Binary (Be a)) => ElfData -> a -> Put
putEndian ElfData
ELFDATA2MSB

putLe :: (Binary (Le b), Binary (Be b)) => b -> Put
putLe :: forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe = forall a. (Binary (Le a), Binary (Be a)) => ElfData -> a -> Put
putEndian ElfData
ELFDATA2LSB

--------------------------------------------------------------------------
-- WordXX
--------------------------------------------------------------------------

-- | @SingElfClassI a@ is defined for each constructor of `ElfClass`.
--   It defines @WordXX a@, which is `Word32` for `ELFCLASS32` and `Word64` for `ELFCLASS64`.
--   Also it defines singletons for each of the `ElfClass` type.
class ( Typeable c
      , Typeable (WordXX c)
      , Data (WordXX c)
      , Show (WordXX c)
      , Read (WordXX c)
      , Eq (WordXX c)
      , Ord (WordXX c)
      , Bounded (WordXX c)
      , Enum (WordXX c)
      , Num (WordXX c)
      , Integral (WordXX c)
      , Real (WordXX c)
      , Bits (WordXX c)
      , FiniteBits (WordXX c)
      , Binary (Be (WordXX c))
      , Binary (Le (WordXX c))
      ) => SingElfClassI (c :: ElfClass) where
    type WordXX c = r | r -> c
    singElfClass :: SingElfClass c

instance SingElfClassI 'ELFCLASS32 where
    type WordXX 'ELFCLASS32 = Word32
    singElfClass :: SingElfClass 'ELFCLASS32
singElfClass = SingElfClass 'ELFCLASS32
SELFCLASS32

instance SingElfClassI 'ELFCLASS64 where
    type WordXX 'ELFCLASS64 = Word64
    singElfClass :: SingElfClass 'ELFCLASS64
singElfClass = SingElfClass 'ELFCLASS64
SELFCLASS64

-- | Convenience function for creating a context with an implicit singleton available.
--   See also [@withSing@](https://hackage.haskell.org/package/singletons-3.0.2/docs/Data-Singletons.html#v:withSingI)
withSingElfClassI :: SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI :: forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass c
SELFCLASS64 SingElfClassI c => r
x = SingElfClassI c => r
x
withSingElfClassI SingElfClass c
SELFCLASS32 SingElfClassI c => r
x = SingElfClassI c => r
x

-- | A convenience function useful when we need to name a singleton value multiple times.
--   Without this function, each use of sing could potentially refer to a different singleton,
--   and one has to use type signatures (often with ScopedTypeVariables) to ensure that they are the same.
--   See also [@withSingI@](https://hackage.haskell.org/package/singletons-3.0.2/docs/Data-Singletons.html#v:withSing)
withSingElfClass :: SingElfClassI c => (SingElfClass c -> r) -> r
withSingElfClass :: forall (c :: ElfClass) r.
SingElfClassI c =>
(SingElfClass c -> r) -> r
withSingElfClass SingElfClass c -> r
f = SingElfClass c -> r
f forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass

-- | Convert a singleton to its unrefined version.
--   See also [@fromSing@](https://hackage.haskell.org/package/singletons-3.0.2/docs/Data-Singletons.html#v:fromSing)
fromSingElfClass :: SingElfClass c -> ElfClass
fromSingElfClass :: forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass SingElfClass c
SELFCLASS32 = ElfClass
ELFCLASS32
fromSingElfClass SingElfClass c
SELFCLASS64 = ElfClass
ELFCLASS64

withElfClass' :: ElfClass -> (forall c . SingElfClass c -> r) -> r
withElfClass' :: forall r.
ElfClass -> (forall (c :: ElfClass). SingElfClass c -> r) -> r
withElfClass' ElfClass
ELFCLASS32 forall (c :: ElfClass). SingElfClass c -> r
f = forall (c :: ElfClass). SingElfClass c -> r
f SingElfClass 'ELFCLASS32
SELFCLASS32
withElfClass' ElfClass
ELFCLASS64 forall (c :: ElfClass). SingElfClass c -> r
f = forall (c :: ElfClass). SingElfClass c -> r
f SingElfClass 'ELFCLASS64
SELFCLASS64

-- | Use this instead of [@toSing@](https://hackage.haskell.org/package/singletons-3.0.2/docs/Data-Singletons.html#v:toSing)
withElfClass :: ElfClass -> (forall c . SingElfClassI c => SingElfClass c -> r) -> r
withElfClass :: forall r.
ElfClass
-> (forall (c :: ElfClass). SingElfClassI c => SingElfClass c -> r)
-> r
withElfClass ElfClass
c forall (c :: ElfClass). SingElfClassI c => SingElfClass c -> r
f = forall r.
ElfClass -> (forall (c :: ElfClass). SingElfClass c -> r) -> r
withElfClass' ElfClass
c (\SingElfClass c
s -> forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass c
s forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClassI c => SingElfClass c -> r
f SingElfClass c
s)

--------------------------------------------------------------------------
-- Header
--------------------------------------------------------------------------

-- | Parsed ELF header
data HeaderXX c =
    HeaderXX
        { forall (c :: ElfClass). HeaderXX c -> ElfData
hData       :: ElfData    -- ^ Data encoding (big- or little-endian)
        , forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hOSABI      :: ElfOSABI   -- ^ OS/ABI identification
        , forall (c :: ElfClass). HeaderXX c -> Word8
hABIVersion :: Word8      -- ^ ABI version
        , forall (c :: ElfClass). HeaderXX c -> ElfType
hType       :: ElfType    -- ^ Object file type
        , forall (c :: ElfClass). HeaderXX c -> ElfMachine
hMachine    :: ElfMachine -- ^ Machine type
        , forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry      :: WordXX c   -- ^ Entry point address
        , forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff      :: WordXX c   -- ^ Program header offset
        , forall (c :: ElfClass). HeaderXX c -> WordXX c
hShOff      :: WordXX c   -- ^ Section header offset
        , forall (c :: ElfClass). HeaderXX c -> Word32
hFlags      :: Word32     -- ^ Processor-specific flags
        , forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize  :: Word16     -- ^ Size of program header entry
        , forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum      :: Word16     -- ^ Number of program header entries
        , forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize  :: Word16     -- ^ Size of section header entry
        , forall (c :: ElfClass). HeaderXX c -> Word16
hShNum      :: Word16     -- ^ Number of section header entries
        , forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShStrNdx   :: ElfSectionIndex -- ^ Section name string table index
        }

-- | Header is a sigma type where the first entry defines the type of the second one
data Header = forall a . Header (SingElfClass a) (HeaderXX a)

-- | Size of ELF header.
headerSize :: Num a => ElfClass -> a
headerSize :: forall a. Num a => ElfClass -> a
headerSize ElfClass
ELFCLASS64 = a
64
headerSize ElfClass
ELFCLASS32 = a
52

-- | Size of section table entry.
sectionTableEntrySize :: Num a => ElfClass -> a
sectionTableEntrySize :: forall a. Num a => ElfClass -> a
sectionTableEntrySize ElfClass
ELFCLASS64 = a
64
sectionTableEntrySize ElfClass
ELFCLASS32 = a
40

-- | Size of segment table entry.
segmentTableEntrySize :: Num a => ElfClass -> a
segmentTableEntrySize :: forall a. Num a => ElfClass -> a
segmentTableEntrySize ElfClass
ELFCLASS64 = a
56
segmentTableEntrySize ElfClass
ELFCLASS32 = a
32

-- | Size of symbol table entry.
symbolTableEntrySize :: Num a => ElfClass -> a
symbolTableEntrySize :: forall a. Num a => ElfClass -> a
symbolTableEntrySize ElfClass
ELFCLASS64 = a
24
symbolTableEntrySize ElfClass
ELFCLASS32 = a
16

-- | Size of @WordXX a@ in bytes.
wordSize :: Num a => ElfClass -> a
wordSize :: forall a. Num a => ElfClass -> a
wordSize ElfClass
ELFCLASS64 = a
8
wordSize ElfClass
ELFCLASS32 = a
4

getHeader' :: SingElfClassI c => SingElfClass c -> Get Header
getHeader' :: forall (c :: ElfClass).
SingElfClassI c =>
SingElfClass c -> Get Header
getHeader' SingElfClass c
classS = do

    ElfData
hData <- forall t. Binary t => Get t
get
    forall a. (Binary a, Eq a) => String -> a -> Get ()
verify String
"version1" Word8
elfSupportedVersion
    ElfOSABI
hOSABI <- forall t. Binary t => Get t
get
    Word8
hABIVersion <- forall t. Binary t => Get t
get
    Int -> Get ()
skip Int
7

    let
        getE :: (Binary (Le b), Binary (Be b)) => Get b
        getE :: forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = forall a. (Binary (Le a), Binary (Be a)) => ElfData -> Get a
getEndian ElfData
hData

    ElfType
hType <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    ElfMachine
hMachine <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    (Word32
hVersion2 :: Word32) <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
hVersion2 forall a. Eq a => a -> a -> Bool
/= Word32
1) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"verification failed: version2"

    WordXX c
hEntry <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
hPhOff <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
hShOff <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    Word32
hFlags <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    (Word16
hSize :: Word16) <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word16
hSize forall a. Eq a => a -> a -> Bool
/= forall a. Num a => ElfClass -> a
headerSize (forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass SingElfClass c
classS)) forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"incorrect size of elf header"
    Word16
hPhEntSize <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word16
hPhNum <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word16
hShEntSize <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word16
hShNum <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    ElfSectionIndex
hShStrNdx <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: ElfClass). SingElfClass a -> HeaderXX a -> Header
Header SingElfClass c
classS HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX c
ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX c
hPhOff :: WordXX c
hEntry :: WordXX c
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX c
hPhOff :: WordXX c
hEntry :: WordXX c
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
..}

getHeader :: Get Header
getHeader :: Get Header
getHeader = do
    forall a. (Binary a, Eq a) => String -> a -> Get ()
verify String
"magic" Be Word32
elfMagic
    (ElfClass
hClass :: ElfClass) <- forall t. Binary t => Get t
get
    forall r.
ElfClass
-> (forall (c :: ElfClass). SingElfClassI c => SingElfClass c -> r)
-> r
withElfClass ElfClass
hClass forall (c :: ElfClass).
SingElfClassI c =>
SingElfClass c -> Get Header
getHeader'

putHeader :: Header -> Put
putHeader :: Header -> Put
putHeader (Header SingElfClass a
classS HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX a
hPhOff :: WordXX a
hEntry :: WordXX a
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
..}) = forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS do

    forall t. Binary t => t -> Put
put Be Word32
elfMagic
    forall t. Binary t => t -> Put
put forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass SingElfClass a
classS
    forall t. Binary t => t -> Put
put ElfData
hData
    forall t. Binary t => t -> Put
put Word8
elfSupportedVersion
    forall t. Binary t => t -> Put
put ElfOSABI
hOSABI
    forall t. Binary t => t -> Put
put Word8
hABIVersion

    ByteString -> Put
putByteString forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> ByteString
BS.replicate Int
7 Word8
0

    let
        putE :: (Binary (Le b), Binary (Be b)) => b -> Put
        putE :: forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE = forall a. (Binary (Le a), Binary (Be a)) => ElfData -> a -> Put
putEndian ElfData
hData

    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfType
hType
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfMachine
hMachine
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (Word32
1 :: Word32)
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX a
hEntry
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX a
hPhOff
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX a
hShOff
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
hFlags
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (forall a. Num a => ElfClass -> a
headerSize forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass). SingElfClass c -> ElfClass
fromSingElfClass SingElfClass a
classS :: Word16)
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word16
hPhEntSize
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word16
hPhNum
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word16
hShEntSize
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word16
hShNum
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSectionIndex
hShStrNdx

instance Binary Header where
    put :: Header -> Put
put = Header -> Put
putHeader
    get :: Get Header
get = Get Header
getHeader

--------------------------------------------------------------------------
-- Section
--------------------------------------------------------------------------

-- | Parsed ELF section table entry
data SectionXX c =
    SectionXX
        { forall (c :: ElfClass). SectionXX c -> Word32
sName      :: Word32         -- ^ Section name
        , forall (c :: ElfClass). SectionXX c -> ElfSectionType
sType      :: ElfSectionType -- ^ Section type
        , forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags     :: WordXX c       -- ^ Section attributes
        , forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr      :: WordXX c       -- ^ Virtual address in memory
        , forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset    :: WordXX c       -- ^ Offset in file
        , forall (c :: ElfClass). SectionXX c -> WordXX c
sSize      :: WordXX c       -- ^ Size of section
        , forall (c :: ElfClass). SectionXX c -> Word32
sLink      :: Word32         -- ^ Link to other section
        , forall (c :: ElfClass). SectionXX c -> Word32
sInfo      :: Word32         -- ^ Miscellaneous information
        , forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: WordXX c       -- ^ Address alignment boundary
        , forall (c :: ElfClass). SectionXX c -> WordXX c
sEntSize   :: WordXX c       -- ^ Size of entries, if section has table
        }

getSection ::                            SingElfClassI c =>
    (forall b . (Binary (Le b), Binary (Be b)) => Get b) -> Get (SectionXX c)
getSection :: forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX c)
getSection forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do

    Word32
sName      <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    ElfSectionType
sType      <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sFlags     <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sAddr      <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sOffset    <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sSize      <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
sLink      <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
sInfo      <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sAddrAlign <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
sEntSize   <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    forall (m :: * -> *) a. Monad m => a -> m a
return SectionXX {Word32
ElfSectionType
WordXX c
sEntSize :: WordXX c
sAddrAlign :: WordXX c
sInfo :: Word32
sLink :: Word32
sSize :: WordXX c
sOffset :: WordXX c
sAddr :: WordXX c
sFlags :: WordXX c
sType :: ElfSectionType
sName :: Word32
sEntSize :: WordXX c
sAddrAlign :: WordXX c
sInfo :: Word32
sLink :: Word32
sSize :: WordXX c
sOffset :: WordXX c
sAddr :: WordXX c
sFlags :: WordXX c
sType :: ElfSectionType
sName :: Word32
..}

putSection ::                               SingElfClassI c =>
    (forall b . (Binary (Le b), Binary (Be b)) => b -> Put) ->
                                                SectionXX c -> Put
putSection :: forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX c -> Put
putSection forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (SectionXX{Word32
ElfSectionType
WordXX c
sEntSize :: WordXX c
sAddrAlign :: WordXX c
sInfo :: Word32
sLink :: Word32
sSize :: WordXX c
sOffset :: WordXX c
sAddr :: WordXX c
sFlags :: WordXX c
sType :: ElfSectionType
sName :: Word32
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
..}) = do

    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
sName
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSectionType
sType
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sFlags
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sAddr
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sOffset
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sSize
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
sLink
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
sInfo
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sAddrAlign
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sEntSize

instance forall (a :: ElfClass) . SingElfClassI a => Binary (Be (SectionXX a)) where
    put :: Be (SectionXX a) -> Put
put = forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) (forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX c -> Put
putSection forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Be a -> a
fromBe
    get :: Get (Be (SectionXX a))
get = forall a. a -> Be a
Be forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) (forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX c)
getSection forall b. (Binary (Le b), Binary (Be b)) => Get b
getBe)

instance forall (a :: ElfClass) . SingElfClassI a => Binary (Le (SectionXX a)) where
    put :: Le (SectionXX a) -> Put
put = forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) (forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX c -> Put
putSection forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Le a -> a
fromLe
    get :: Get (Le (SectionXX a))
get = forall a. a -> Le a
Le forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) (forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX c)
getSection forall b. (Binary (Le b), Binary (Be b)) => Get b
getLe)

--------------------------------------------------------------------------
-- Segment
--------------------------------------------------------------------------

-- | Parsed ELF segment table entry
data SegmentXX c =
    SegmentXX
        { forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
pType     :: ElfSegmentType -- ^ Type of segment
        , forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pFlags    :: ElfSegmentFlag -- ^ Segment attributes
        , forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset   :: WordXX c       -- ^ Offset in file
        , forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: WordXX c       -- ^ Virtual address in memory
        , forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: WordXX c       -- ^ Physical address
        , forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: WordXX c       -- ^ Size of segment in file
        , forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize  :: WordXX c       -- ^ Size of segment in memory
        , forall (c :: ElfClass). SegmentXX c -> WordXX c
pAlign    :: WordXX c       -- ^ Alignment of segment
        }

getSegment ::    forall (c :: ElfClass) . SingElfClass c ->
    (forall b . (Binary (Le b), Binary (Be b)) => Get b) -> Get (SegmentXX c)
getSegment :: forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX c)
getSegment SingElfClass c
SELFCLASS64 forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do

    ElfSegmentType
pType     <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    ElfSegmentFlag
pFlags    <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pOffset   <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pVirtAddr <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pPhysAddr <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pFileSize <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pMemSize  <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
pAlign    <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    forall (m :: * -> *) a. Monad m => a -> m a
return SegmentXX{Word64
ElfSegmentType
ElfSegmentFlag
pAlign :: Word64
pMemSize :: Word64
pFileSize :: Word64
pPhysAddr :: Word64
pVirtAddr :: Word64
pOffset :: Word64
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: WordXX c
pMemSize :: WordXX c
pFileSize :: WordXX c
pPhysAddr :: WordXX c
pVirtAddr :: WordXX c
pOffset :: WordXX c
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
..}

getSegment SingElfClass c
SELFCLASS32 forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do

    ElfSegmentType
pType     <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pOffset   <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pVirtAddr <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pPhysAddr <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pFileSize <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pMemSize  <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    ElfSegmentFlag
pFlags    <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
pAlign    <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    forall (m :: * -> *) a. Monad m => a -> m a
return SegmentXX{Word32
ElfSegmentType
ElfSegmentFlag
pAlign :: Word32
pFlags :: ElfSegmentFlag
pMemSize :: Word32
pFileSize :: Word32
pPhysAddr :: Word32
pVirtAddr :: Word32
pOffset :: Word32
pType :: ElfSegmentType
pAlign :: WordXX c
pMemSize :: WordXX c
pFileSize :: WordXX c
pPhysAddr :: WordXX c
pVirtAddr :: WordXX c
pOffset :: WordXX c
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
..}

putSegment ::       forall (c :: ElfClass) . SingElfClass c ->
    (forall b . (Binary (Le b), Binary (Be b)) => b -> Put) ->
                                                SegmentXX c -> Put
putSegment :: forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX c
-> Put
putSegment SingElfClass c
SELFCLASS64 forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX c
pAlign :: WordXX c
pMemSize :: WordXX c
pFileSize :: WordXX c
pPhysAddr :: WordXX c
pVirtAddr :: WordXX c
pOffset :: WordXX c
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
..}) = do

    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSegmentType
pType
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSegmentFlag
pFlags
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pOffset
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pVirtAddr
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pPhysAddr
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pFileSize
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pMemSize
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pAlign

putSegment SingElfClass c
SELFCLASS32 forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (SegmentXX{ElfSegmentType
ElfSegmentFlag
WordXX c
pAlign :: WordXX c
pMemSize :: WordXX c
pFileSize :: WordXX c
pPhysAddr :: WordXX c
pVirtAddr :: WordXX c
pOffset :: WordXX c
pFlags :: ElfSegmentFlag
pType :: ElfSegmentType
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
..}) = do

    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSegmentType
pType
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pOffset
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pVirtAddr
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pPhysAddr
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pFileSize
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pMemSize
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSegmentFlag
pFlags
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
pAlign


instance forall (a :: ElfClass) . SingElfClassI a => Binary (Be (SegmentXX a)) where
    put :: Be (SegmentXX a) -> Put
put = forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX c
-> Put
putSegment forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Be a -> a
fromBe
    get :: Get (Be (SegmentXX a))
get = forall a. a -> Be a
Be forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX c)
getSegment forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass forall b. (Binary (Le b), Binary (Be b)) => Get b
getBe

instance forall (a :: ElfClass) . SingElfClassI a => Binary (Le (SegmentXX a)) where
    put :: Le (SegmentXX a) -> Put
put = forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX c
-> Put
putSegment forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Le a -> a
fromLe
    get :: Get (Le (SegmentXX a))
get = forall a. a -> Le a
Le forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX c)
getSegment forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass forall b. (Binary (Le b), Binary (Be b)) => Get b
getLe

-- | Get section data
getSectionData :: SingElfClassI a
               => BSL.ByteString -- ^ ELF file
               -> SectionXX a    -- ^ Parsed section entry
               -> BSL.ByteString -- ^ Section Data
getSectionData :: forall (a :: ElfClass).
SingElfClassI a =>
ByteString -> SectionXX a -> ByteString
getSectionData ByteString
bs SectionXX{Word32
ElfSectionType
WordXX a
sEntSize :: WordXX a
sAddrAlign :: WordXX a
sInfo :: Word32
sLink :: Word32
sSize :: WordXX a
sOffset :: WordXX a
sAddr :: WordXX a
sFlags :: WordXX a
sType :: ElfSectionType
sName :: Word32
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sName :: forall (c :: ElfClass). SectionXX c -> Word32
..} = Int64 -> ByteString -> ByteString
BSL.take Int64
s forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop Int64
o ByteString
bs
    where
        o :: Int64
o = forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
sOffset
        s :: Int64
s = forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
sSize

--------------------------------------------------------------------------
-- Symbol table entry
--------------------------------------------------------------------------

-- | Test if the section with such integer value of section type field (`sType`)
--   contains symbol table
sectionIsSymbolTable :: ElfSectionType -> Bool
sectionIsSymbolTable :: ElfSectionType -> Bool
sectionIsSymbolTable ElfSectionType
sType  = ElfSectionType
sType forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.elem` [ElfSectionType
SHT_SYMTAB, ElfSectionType
SHT_DYNSYM]

-- | Parsed ELF symbol table entry
data SymbolXX c =
    SymbolXX
        { forall (c :: ElfClass). SymbolXX c -> Word32
stName  :: Word32          -- ^ Symbol name
        , forall (c :: ElfClass). SymbolXX c -> Word8
stInfo  :: Word8           -- ^ Type and Binding attributes
        , forall (c :: ElfClass). SymbolXX c -> Word8
stOther :: Word8           -- ^ Reserved
        , forall (c :: ElfClass). SymbolXX c -> ElfSectionIndex
stShNdx :: ElfSectionIndex -- ^ Section table index
        , forall (c :: ElfClass). SymbolXX c -> WordXX c
stValue :: WordXX c        -- ^ Symbol value
        , forall (c :: ElfClass). SymbolXX c -> WordXX c
stSize  :: WordXX c        -- ^ Size of object
        }

getSymbolTableEntry :: forall (c :: ElfClass) . SingElfClass c ->
          (forall b . (Binary (Le b), Binary (Be b)) => Get b) -> Get (SymbolXX c)
getSymbolTableEntry :: forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX c)
getSymbolTableEntry SingElfClass c
SELFCLASS64 forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do

    Word32
stName  <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word8
stInfo  <- forall t. Binary t => Get t
get
    Word8
stOther <- forall t. Binary t => Get t
get
    ElfSectionIndex
stShNdx <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
stValue <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word64
stSize  <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    forall (m :: * -> *) a. Monad m => a -> m a
return SymbolXX{Word8
Word32
Word64
ElfSectionIndex
stSize :: Word64
stValue :: Word64
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
stSize :: WordXX c
stValue :: WordXX c
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
..}

getSymbolTableEntry SingElfClass c
SELFCLASS32 forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do

    Word32
stName  <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
stValue <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word32
stSize  <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    Word8
stInfo  <- forall t. Binary t => Get t
get
    Word8
stOther <- forall t. Binary t => Get t
get
    ElfSectionIndex
stShNdx <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE

    forall (m :: * -> *) a. Monad m => a -> m a
return SymbolXX{Word8
Word32
ElfSectionIndex
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stSize :: Word32
stValue :: Word32
stName :: Word32
stSize :: WordXX c
stValue :: WordXX c
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
..}

putSymbolTableEntry :: forall (c :: ElfClass) . SingElfClass c ->
       (forall b . (Binary (Le b), Binary (Be b)) => b -> Put) ->
                                                    SymbolXX c -> Put
putSymbolTableEntry :: forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX c
-> Put
putSymbolTableEntry SingElfClass c
SELFCLASS64 forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (SymbolXX{Word8
Word32
ElfSectionIndex
WordXX c
stSize :: WordXX c
stValue :: WordXX c
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
stSize :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stValue :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stShNdx :: forall (c :: ElfClass). SymbolXX c -> ElfSectionIndex
stOther :: forall (c :: ElfClass). SymbolXX c -> Word8
stInfo :: forall (c :: ElfClass). SymbolXX c -> Word8
stName :: forall (c :: ElfClass). SymbolXX c -> Word32
..}) = do

    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
stName
    forall t. Binary t => t -> Put
put  Word8
stInfo
    forall t. Binary t => t -> Put
put  Word8
stOther
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSectionIndex
stShNdx
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
stValue
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
stSize

putSymbolTableEntry SingElfClass c
SELFCLASS32 forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (SymbolXX{Word8
Word32
ElfSectionIndex
WordXX c
stSize :: WordXX c
stValue :: WordXX c
stShNdx :: ElfSectionIndex
stOther :: Word8
stInfo :: Word8
stName :: Word32
stSize :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stValue :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stShNdx :: forall (c :: ElfClass). SymbolXX c -> ElfSectionIndex
stOther :: forall (c :: ElfClass). SymbolXX c -> Word8
stInfo :: forall (c :: ElfClass). SymbolXX c -> Word8
stName :: forall (c :: ElfClass). SymbolXX c -> Word32
..}) = do

    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
stName
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
stValue
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
stSize
    forall t. Binary t => t -> Put
put  Word8
stInfo
    forall t. Binary t => t -> Put
put  Word8
stOther
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSectionIndex
stShNdx

instance forall (a :: ElfClass) . SingElfClassI a => Binary (Be (SymbolXX a)) where
    put :: Be (SymbolXX a) -> Put
put = forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX c
-> Put
putSymbolTableEntry forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Be a -> a
fromBe
    get :: Get (Be (SymbolXX a))
get = forall a. a -> Be a
Be forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX c)
getSymbolTableEntry forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass forall b. (Binary (Le b), Binary (Be b)) => Get b
getBe

instance forall (a :: ElfClass) . SingElfClassI a => Binary (Le (SymbolXX a)) where
    put :: Le (SymbolXX a) -> Put
put = forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX c
-> Put
putSymbolTableEntry forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Le a -> a
fromLe
    get :: Get (Le (SymbolXX a))
get = forall a. a -> Le a
Le forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX c)
getSymbolTableEntry forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass forall b. (Binary (Le b), Binary (Be b)) => Get b
getLe

--------------------------------------------------------------------------
-- relocation table entry
--------------------------------------------------------------------------

-- | Parsed relocation table entry (@ElfXX_Rela@)
data RelaXX c =
    RelaXX
        { forall (c :: ElfClass). RelaXX c -> WordXX c
relaOffset :: WordXX c -- ^ Address of reference
        , forall (c :: ElfClass). RelaXX c -> Word32
relaSym    :: Word32   -- ^ Symbol table index
        , forall (c :: ElfClass). RelaXX c -> Word32
relaType   :: Word32   -- ^ Relocation type
        , forall (c :: ElfClass). RelaXX c -> WordXX c
relaAddend :: WordXX c -- ^ Constant part of expression
        }

relaSym32 :: Word32 -> Word32
relaSym32 :: Word32 -> Word32
relaSym32 Word32
v = Word32
v forall a. Bits a => a -> Int -> a
`shiftR` Int
8

relaType32 :: Word32 -> Word32
relaType32 :: Word32 -> Word32
relaType32 Word32
v = Word32
v forall a. Bits a => a -> a -> a
.&. Word32
0xff

relaSym64 :: Word64 -> Word32
relaSym64 :: Word64 -> Word32
relaSym64 Word64
v = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
v forall a. Bits a => a -> Int -> a
`shiftR` Int
32

relaType64 :: Word64 -> Word32
relaType64 :: Word64 -> Word32
relaType64 Word64
v = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word64
v forall a. Bits a => a -> a -> a
.&. Word64
0xffffffff

relaInfo32 :: Word32 -> Word32 -> Word32
relaInfo32 :: Word32 -> Word32 -> Word32
relaInfo32 Word32
s Word32
t = (Word32
t forall a. Bits a => a -> a -> a
.&. Word32
0xff) forall a. Bits a => a -> a -> a
.|. (Word32
s forall a. Bits a => a -> Int -> a
`shiftL` Int
8)

relaInfo64 :: Word32 -> Word32 -> Word64
relaInfo64 :: Word32 -> Word32 -> Word64
relaInfo64 Word32
s Word32
t = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
t forall a. Bits a => a -> a -> a
.|. (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
s forall a. Bits a => a -> Int -> a
`shiftL` Int
32)

getRelocationTableAEntry ::   forall c . SingElfClassI c =>
    (forall b . (Binary (Le b), Binary (Be b)) => Get b) -> Get (RelaXX c)
getRelocationTableAEntry :: forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX c)
getRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => Get b
getE = do
    WordXX c
relaOffset <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    (Word32
relaSym, Word32
relaType) <- case forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @c of
        SingElfClass c
SELFCLASS64 -> (\Word64
x -> (Word64 -> Word32
relaSym64 Word64
x, Word64 -> Word32
relaType64 Word64
x)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
        SingElfClass c
SELFCLASS32 -> (\Word32
x -> (Word32 -> Word32
relaSym32 Word32
x, Word32 -> Word32
relaType32 Word32
x)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    WordXX c
relaAddend <- forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    forall (m :: * -> *) a. Monad m => a -> m a
return RelaXX{Word32
WordXX c
relaAddend :: WordXX c
relaType :: Word32
relaSym :: Word32
relaOffset :: WordXX c
relaAddend :: WordXX c
relaType :: Word32
relaSym :: Word32
relaOffset :: WordXX c
..}

putRelocationTableAEntry ::      forall c . SingElfClassI c =>
    (forall b . (Binary (Le b), Binary (Be b)) => b -> Put) ->
                                  RelaXX c -> Put
putRelocationTableAEntry :: forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX c -> Put
putRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (RelaXX{Word32
WordXX c
relaAddend :: WordXX c
relaType :: Word32
relaSym :: Word32
relaOffset :: WordXX c
relaAddend :: forall (c :: ElfClass). RelaXX c -> WordXX c
relaType :: forall (c :: ElfClass). RelaXX c -> Word32
relaSym :: forall (c :: ElfClass). RelaXX c -> Word32
relaOffset :: forall (c :: ElfClass). RelaXX c -> WordXX c
..}) = do
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
relaOffset
    (case forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @c of
        SingElfClass c
SELFCLASS64 -> forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word64
relaInfo64 Word32
relaSym Word32
relaType
        SingElfClass c
SELFCLASS32 -> forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32
relaInfo32 Word32
relaSym Word32
relaType) :: Put
    forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
relaAddend

instance forall (a :: ElfClass) . SingElfClassI a => Binary (Be (RelaXX a)) where
    put :: Be (RelaXX a) -> Put
put = forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) (forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX c -> Put
putRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Be a -> a
fromBe
    get :: Get (Be (RelaXX a))
get = forall a. a -> Be a
Be forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) (forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX c)
getRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => Get b
getBe)

instance forall (a :: ElfClass) . SingElfClassI a => Binary (Le (RelaXX a)) where
    put :: Le (RelaXX a) -> Put
put = forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) (forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX c -> Put
putRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Le a -> a
fromLe
    get :: Get (Le (RelaXX a))
get = forall a. a -> Le a
Le forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) (forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX c)
getRelocationTableAEntry forall b. (Binary (Le b), Binary (Be b)) => Get b
getLe)

-- | Size of @RelaXX a@ in bytes.
relocationTableAEntrySize :: forall a . SingElfClassI a => WordXX a
relocationTableAEntrySize :: forall (a :: ElfClass). SingElfClassI a => WordXX a
relocationTableAEntrySize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length forall a b. (a -> b) -> a -> b
$ forall a. Binary a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall a. a -> Le a
Le forall a b. (a -> b) -> a -> b
$ forall (c :: ElfClass).
WordXX c -> Word32 -> Word32 -> WordXX c -> RelaXX c
RelaXX @a WordXX a
0 Word32
0 Word32
0 WordXX a
0

--------------------------------------------------------------------------
-- parseHeaders
--------------------------------------------------------------------------

elfDecodeOrFail' :: (Binary a, MonadThrow m) => BSL.ByteString -> m (ByteOffset, a)
elfDecodeOrFail' :: forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m (Int64, a)
elfDecodeOrFail' ByteString
bs = case forall a.
Binary a =>
ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
decodeOrFail ByteString
bs of
    Left (ByteString
_, Int64
off, String
err) -> $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError forall a b. (a -> b) -> a -> b
$ String
err forall a. [a] -> [a] -> [a]
++ String
" @" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int64
off
    Right (ByteString
_, Int64
off, a
a) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int64
off, a
a)

elfDecodeOrFail :: (Binary a, MonadThrow m) => BSL.ByteString -> m a
elfDecodeOrFail :: forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m a
elfDecodeOrFail ByteString
bs = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m (Int64, a)
elfDecodeOrFail' ByteString
bs

elfDecodeAllOrFail :: (Binary a, MonadThrow m) => BSL.ByteString -> m a
elfDecodeAllOrFail :: forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m a
elfDecodeAllOrFail ByteString
bs = do
    (Int64
off, a
a) <- forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m (Int64, a)
elfDecodeOrFail' ByteString
bs
    if Int64
off forall a. Eq a => a -> a -> Bool
== ByteString -> Int64
BSL.length ByteString
bs then forall (m :: * -> *) a. Monad m => a -> m a
return a
a else $Int
String
String -> String -> String -> CharPos -> CharPos -> Loc
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError forall a b. (a -> b) -> a -> b
$ String
"leftover != 0 @" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int64
off

-- | Parse an array
parseBList :: (MonadThrow m, Binary (Le a), Binary (Be a))
           => ElfData        -- ^ Tells if parser should expect big or little endian data
           -> BSL.ByteString -- ^ Data for parsing
           -> m [a]
parseBList :: forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
d ByteString
bs = case ElfData
d of
    ElfData
ELFDATA2LSB -> forall a. BList a -> [a]
fromBList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Le a -> a
fromLe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m a
elfDecodeAllOrFail ByteString
bs
    ElfData
ELFDATA2MSB -> forall a. BList a -> [a]
fromBList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Be a -> a
fromBe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m a
elfDecodeAllOrFail ByteString
bs

-- | Serialize an array
serializeBList :: (Binary (Le a), Binary (Be a))
               => ElfData -- ^ Tells if serializer should tread the data as bit or little endian
               -> [a]     -- ^ The array to serialize
               -> BSL.ByteString
serializeBList :: forall a.
(Binary (Le a), Binary (Be a)) =>
ElfData -> [a] -> ByteString
serializeBList ElfData
d [a]
as = case ElfData
d of
    ElfData
ELFDATA2LSB -> forall a. Binary a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall a. a -> Le a
Le forall a b. (a -> b) -> a -> b
$ forall a. [a] -> BList a
BList [a]
as
    ElfData
ELFDATA2MSB -> forall a. Binary a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall a. a -> Be a
Be forall a b. (a -> b) -> a -> b
$ forall a. [a] -> BList a
BList [a]
as

-- | Sigma type to hold the ELF header and section and segment tables for a given `ElfClass`.
data Headers = forall a . Headers (SingElfClass a) (HeaderXX a) [SectionXX a] [SegmentXX a]

parseHeaders' :: (SingElfClassI a, MonadThrow m) => HeaderXX a -> BSL.ByteString -> m Headers
parseHeaders' :: forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadThrow m) =>
HeaderXX a -> ByteString -> m Headers
parseHeaders' hxx :: HeaderXX a
hxx@HeaderXX{Word8
Word16
Word32
ElfOSABI
ElfType
ElfMachine
ElfSectionIndex
WordXX a
ElfData
hShStrNdx :: ElfSectionIndex
hShNum :: Word16
hShEntSize :: Word16
hPhNum :: Word16
hPhEntSize :: Word16
hFlags :: Word32
hShOff :: WordXX a
hPhOff :: WordXX a
hEntry :: WordXX a
hMachine :: ElfMachine
hType :: ElfType
hABIVersion :: Word8
hOSABI :: ElfOSABI
hData :: ElfData
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
..} ByteString
bs =
    let
        takeLen :: WordXX a -> Word16 -> ByteString
takeLen WordXX a
off Word16
len = Int64 -> ByteString -> ByteString
BSL.take (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop (forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
off) ByteString
bs
        bsSections :: ByteString
bsSections = WordXX a -> Word16 -> ByteString
takeLen WordXX a
hShOff (Word16
hShEntSize forall a. Num a => a -> a -> a
* Word16
hShNum)
        bsSegments :: ByteString
bsSegments = WordXX a -> Word16 -> ByteString
takeLen WordXX a
hPhOff (Word16
hPhEntSize forall a. Num a => a -> a -> a
* Word16
hPhNum)
    in do
        [SectionXX a]
ss <- forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
hData ByteString
bsSections
        [SegmentXX a]
ps <- forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
hData ByteString
bsSegments
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (a :: ElfClass).
SingElfClass a
-> HeaderXX a -> [SectionXX a] -> [SegmentXX a] -> Headers
Headers forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass HeaderXX a
hxx [SectionXX a]
ss [SegmentXX a]
ps

-- | Parse ELF file and produce header and section and segment tables
parseHeaders :: MonadThrow m => BSL.ByteString -> m Headers
parseHeaders :: forall (m :: * -> *). MonadThrow m => ByteString -> m Headers
parseHeaders ByteString
bs = do
    Header SingElfClass a
classS HeaderXX a
hxx <- forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m a
elfDecodeOrFail ByteString
bs
    forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass a
classS forall (a :: ElfClass) (m :: * -> *).
(SingElfClassI a, MonadThrow m) =>
HeaderXX a -> ByteString -> m Headers
parseHeaders' HeaderXX a
hxx ByteString
bs

-- | Get string from string table
getString :: BSL.ByteString -- ^ Section data of a string table section
          -> Int64          -- ^ Offset to the start of the string in that data
          -> String
getString :: ByteString -> Int64 -> String
getString ByteString
bs Int64
offset = ByteString -> String
BSL8.unpack forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BSL.takeWhile (forall a. Eq a => a -> a -> Bool
/= Word8
0) forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop Int64
offset ByteString
bs