-- |
-- 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
(ElfClass -> ElfClass -> Bool)
-> (ElfClass -> ElfClass -> Bool) -> Eq ElfClass
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElfClass -> ElfClass -> Bool
== :: ElfClass -> ElfClass -> Bool
$c/= :: ElfClass -> ElfClass -> Bool
/= :: 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
$cshowsPrec :: Int -> ElfClass -> ShowS
showsPrec :: Int -> ElfClass -> ShowS
$cshow :: ElfClass -> String
show :: ElfClass -> String
$cshowList :: [ElfClass] -> ShowS
showList :: [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 Get Word8 -> (Word8 -> Get ElfClass) -> Get ElfClass
forall a b. Get a -> (a -> Get b) -> Get b
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ElfClass
ELFCLASS32
            getElfClass_ a
2 = ElfClass -> m ElfClass
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ElfClass
ELFCLASS64
            getElfClass_ a
_ = String -> m ElfClass
forall a. String -> m 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
(ElfData -> ElfData -> Bool)
-> (ElfData -> ElfData -> Bool) -> Eq ElfData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ElfData -> ElfData -> Bool
== :: ElfData -> ElfData -> Bool
$c/= :: ElfData -> ElfData -> Bool
/= :: 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
$cshowsPrec :: Int -> ElfData -> ShowS
showsPrec :: Int -> ElfData -> ShowS
$cshow :: ElfData -> String
show :: ElfData -> String
$cshowList :: [ElfData] -> ShowS
showList :: [ElfData] -> ShowS
Show)

instance Binary ElfData where
    get :: Get ElfData
get = Get Word8
getWord8 Get Word8 -> (Word8 -> Get ElfData) -> Get ElfData
forall a b. Get a -> (a -> Get b) -> Get b
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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ElfData
ELFDATA2LSB
            getElfData_ a
2 = ElfData -> m ElfData
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ElfData
ELFDATA2MSB
            getElfData_ a
_ = String -> m ElfData
forall a. String -> m 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 = Word32 -> Be Word32
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 <- Get a
forall t. Binary t => Get t
get
    when (orig /= a) $ error ("verification failed: " ++ 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 = Le a -> a
forall a. Le a -> a
fromLe (Le a -> a) -> Get (Le a) -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Le a)
forall t. Binary t => Get t
get
getEndian ElfData
ELFDATA2MSB = Be a -> a
forall a. Be a -> a
fromBe (Be a -> a) -> Get (Be a) -> Get a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Be a)
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 = ElfData -> Get b
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 = ElfData -> Get b
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 = Le a -> Put
forall t. Binary t => t -> Put
put (Le a -> Put) -> (a -> Le a) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Le a
forall a. a -> Le a
Le
putEndian ElfData
ELFDATA2MSB = Be a -> Put
forall t. Binary t => t -> Put
put (Be a -> Put) -> (a -> Be a) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Be a
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 = ElfData -> b -> Put
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 = ElfData -> b -> Put
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 = r
SingElfClassI c => r
x
withSingElfClassI SingElfClass c
SELFCLASS32 SingElfClassI c => r
x = r
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 SingElfClass c
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 = SingElfClass 'ELFCLASS32 -> r
forall (c :: ElfClass). SingElfClass c -> r
f SingElfClass 'ELFCLASS32
SELFCLASS32
withElfClass' ElfClass
ELFCLASS64 forall (c :: ElfClass). SingElfClass c -> r
f = SingElfClass 'ELFCLASS64 -> r
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 = ElfClass -> (forall (c :: ElfClass). SingElfClass c -> r) -> r
forall r.
ElfClass -> (forall (c :: ElfClass). SingElfClass c -> r) -> r
withElfClass' ElfClass
c (\SingElfClass c
s -> SingElfClass c -> (SingElfClassI c => r) -> r
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI SingElfClass c
s ((SingElfClassI c => r) -> r) -> (SingElfClassI c => r) -> r
forall a b. (a -> b) -> a -> b
$ SingElfClass c -> r
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

    hData <- Get ElfData
forall t. Binary t => Get t
get
    verify "version1" elfSupportedVersion
    hOSABI <- get
    hABIVersion <- get
    skip 7

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

    hType <- getE
    hMachine <- getE

    (hVersion2 :: Word32) <- getE
    when (hVersion2 /= 1) $ error "verification failed: version2"

    hEntry <- getE
    hPhOff <- getE
    hShOff <- getE

    hFlags <- getE
    (hSize :: Word16) <- getE
    when (hSize /= headerSize (fromSingElfClass classS)) $ error "incorrect size of elf header"
    hPhEntSize <- getE
    hPhNum <- getE
    hShEntSize <- getE
    hShNum <- getE
    hShStrNdx <- getE

    return $ Header classS HeaderXX{..}

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

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

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

    ByteString -> Put
putByteString (ByteString -> Put) -> ByteString -> Put
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 = ElfData -> b -> Put
forall a. (Binary (Le a), Binary (Be a)) => ElfData -> a -> Put
putEndian ElfData
hData

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

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

    return SectionXX {..}

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
sName :: forall (c :: ElfClass). SectionXX c -> Word32
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX c
sAddr :: WordXX c
sOffset :: WordXX c
sSize :: WordXX c
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX c
sEntSize :: WordXX c
..}) = do

    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
sName
    ElfSectionType -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE ElfSectionType
sType
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sFlags
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sAddr
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sOffset
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sSize
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
sLink
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
sInfo
    WordXX c -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE WordXX c
sAddrAlign
    WordXX c -> Put
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 = SingElfClass a
-> (SingElfClassI a => SectionXX a -> Put) -> SectionXX a -> Put
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) ((forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX a -> Put
forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX c -> Put
putSection b -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe) (SectionXX a -> Put)
-> (Be (SectionXX a) -> SectionXX a) -> Be (SectionXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Be (SectionXX a) -> SectionXX a
forall a. Be a -> a
fromBe
    get :: Get (Be (SectionXX a))
get = SectionXX a -> Be (SectionXX a)
forall a. a -> Be a
Be (SectionXX a -> Be (SectionXX a))
-> Get (SectionXX a) -> Get (Be (SectionXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SingElfClass a
-> (SingElfClassI a => Get (SectionXX a)) -> Get (SectionXX a)
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) ((forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX a)
forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX c)
getSection Get b
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 = SingElfClass a
-> (SingElfClassI a => SectionXX a -> Put) -> SectionXX a -> Put
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) ((forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX a -> Put
forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SectionXX c -> Put
putSection b -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe) (SectionXX a -> Put)
-> (Le (SectionXX a) -> SectionXX a) -> Le (SectionXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Le (SectionXX a) -> SectionXX a
forall a. Le a -> a
fromLe
    get :: Get (Le (SectionXX a))
get = SectionXX a -> Le (SectionXX a)
forall a. a -> Le a
Le (SectionXX a -> Le (SectionXX a))
-> Get (SectionXX a) -> Get (Le (SectionXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SingElfClass a
-> (SingElfClassI a => Get (SectionXX a)) -> Get (SectionXX a)
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) ((forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX a)
forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SectionXX c)
getSection Get b
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

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

    return SegmentXX{..}

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

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

    return SegmentXX{..}

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
pType :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentType
pFlags :: forall (c :: ElfClass). SegmentXX c -> ElfSegmentFlag
pOffset :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pVirtAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pPhysAddr :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pFileSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pMemSize :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pAlign :: forall (c :: ElfClass). SegmentXX c -> WordXX c
pType :: ElfSegmentType
pFlags :: ElfSegmentFlag
pOffset :: WordXX c
pVirtAddr :: WordXX c
pPhysAddr :: WordXX c
pFileSize :: WordXX c
pMemSize :: WordXX c
pAlign :: WordXX c
..}) = do

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

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

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


instance forall (a :: ElfClass) . SingElfClassI a => Binary (Be (SegmentXX a)) where
    put :: Be (SegmentXX a) -> Put
put = SingElfClass a
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX a
-> Put
forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX c
-> Put
putSegment SingElfClass a
forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass b -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe (SegmentXX a -> Put)
-> (Be (SegmentXX a) -> SegmentXX a) -> Be (SegmentXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Be (SegmentXX a) -> SegmentXX a
forall a. Be a -> a
fromBe
    get :: Get (Be (SegmentXX a))
get = SegmentXX a -> Be (SegmentXX a)
forall a. a -> Be a
Be (SegmentXX a -> Be (SegmentXX a))
-> Get (SegmentXX a) -> Get (Be (SegmentXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SingElfClass a
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX a)
forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX c)
getSegment SingElfClass a
forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass Get b
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 = SingElfClass a
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX a
-> Put
forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SegmentXX c
-> Put
putSegment SingElfClass a
forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass b -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe (SegmentXX a -> Put)
-> (Le (SegmentXX a) -> SegmentXX a) -> Le (SegmentXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Le (SegmentXX a) -> SegmentXX a
forall a. Le a -> a
fromLe
    get :: Get (Le (SegmentXX a))
get = SegmentXX a -> Le (SegmentXX a)
forall a. a -> Le a
Le (SegmentXX a -> Le (SegmentXX a))
-> Get (SegmentXX a) -> Get (Le (SegmentXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SingElfClass a
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX a)
forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SegmentXX c)
getSegment SingElfClass a
forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass Get b
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
sName :: forall (c :: ElfClass). SectionXX c -> Word32
sType :: forall (c :: ElfClass). SectionXX c -> ElfSectionType
sFlags :: forall (c :: ElfClass). SectionXX c -> WordXX c
sAddr :: forall (c :: ElfClass). SectionXX c -> WordXX c
sOffset :: forall (c :: ElfClass). SectionXX c -> WordXX c
sSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sLink :: forall (c :: ElfClass). SectionXX c -> Word32
sInfo :: forall (c :: ElfClass). SectionXX c -> Word32
sAddrAlign :: forall (c :: ElfClass). SectionXX c -> WordXX c
sEntSize :: forall (c :: ElfClass). SectionXX c -> WordXX c
sName :: Word32
sType :: ElfSectionType
sFlags :: WordXX a
sAddr :: WordXX a
sOffset :: WordXX a
sSize :: WordXX a
sLink :: Word32
sInfo :: Word32
sAddrAlign :: WordXX a
sEntSize :: WordXX a
..} = Int64 -> ByteString -> ByteString
BSL.take Int64
s (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop Int64
o ByteString
bs
    where
        o :: Int64
o = WordXX a -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral WordXX a
sOffset
        s :: Int64
s = WordXX a -> Int64
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 ElfSectionType -> [ElfSectionType] -> Bool
forall a. Eq a => a -> [a] -> Bool
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

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

    return SymbolXX{..}

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

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

    return SymbolXX{..}

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
stName :: forall (c :: ElfClass). SymbolXX c -> Word32
stInfo :: forall (c :: ElfClass). SymbolXX c -> Word8
stOther :: forall (c :: ElfClass). SymbolXX c -> Word8
stShNdx :: forall (c :: ElfClass). SymbolXX c -> ElfSectionIndex
stValue :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stSize :: forall (c :: ElfClass). SymbolXX c -> WordXX c
stName :: Word32
stInfo :: Word8
stOther :: Word8
stShNdx :: ElfSectionIndex
stValue :: WordXX c
stSize :: WordXX c
..}) = do

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

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

    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
stName
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
WordXX c
stValue
    Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE Word32
WordXX c
stSize
    Word8 -> Put
forall t. Binary t => t -> Put
put  Word8
stInfo
    Word8 -> Put
forall t. Binary t => t -> Put
put  Word8
stOther
    ElfSectionIndex -> Put
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 = SingElfClass a
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX a
-> Put
forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX c
-> Put
putSymbolTableEntry SingElfClass a
forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass b -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe (SymbolXX a -> Put)
-> (Be (SymbolXX a) -> SymbolXX a) -> Be (SymbolXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Be (SymbolXX a) -> SymbolXX a
forall a. Be a -> a
fromBe
    get :: Get (Be (SymbolXX a))
get = SymbolXX a -> Be (SymbolXX a)
forall a. a -> Be a
Be (SymbolXX a -> Be (SymbolXX a))
-> Get (SymbolXX a) -> Get (Be (SymbolXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SingElfClass a
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX a)
forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX c)
getSymbolTableEntry SingElfClass a
forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass Get b
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 = SingElfClass a
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX a
-> Put
forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> SymbolXX c
-> Put
putSymbolTableEntry SingElfClass a
forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass b -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe (SymbolXX a -> Put)
-> (Le (SymbolXX a) -> SymbolXX a) -> Le (SymbolXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Le (SymbolXX a) -> SymbolXX a
forall a. Le a -> a
fromLe
    get :: Get (Le (SymbolXX a))
get = SymbolXX a -> Le (SymbolXX a)
forall a. a -> Le a
Le (SymbolXX a -> Le (SymbolXX a))
-> Get (SymbolXX a) -> Get (Le (SymbolXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SingElfClass a
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX a)
forall (c :: ElfClass).
SingElfClass c
-> (forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (SymbolXX c)
getSymbolTableEntry SingElfClass a
forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass Get b
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 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8

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

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

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

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

relaInfo64 :: Word32 -> Word32 -> Word64
relaInfo64 :: Word32 -> Word32 -> Word64
relaInfo64 Word32
s Word32
t = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
t Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. (Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
s Word64 -> Int -> Word64
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
    relaOffset <- Get (WordXX c)
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    (relaSym, relaType) <- case singElfClass @c of
        SingElfClass c
SELFCLASS64 -> (\Word64
x -> (Word64 -> Word32
relaSym64 Word64
x, Word64 -> Word32
relaType64 Word64
x)) (Word64 -> (Word32, Word32)) -> Get Word64 -> Get (Word32, Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word64
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)) (Word32 -> (Word32, Word32)) -> Get Word32 -> Get (Word32, Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get Word32
forall b. (Binary (Le b), Binary (Be b)) => Get b
getE
    relaAddend <- getE
    return RelaXX{..}

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
relaOffset :: forall (c :: ElfClass). RelaXX c -> WordXX c
relaSym :: forall (c :: ElfClass). RelaXX c -> Word32
relaType :: forall (c :: ElfClass). RelaXX c -> Word32
relaAddend :: forall (c :: ElfClass). RelaXX c -> WordXX c
relaOffset :: WordXX c
relaSym :: Word32
relaType :: Word32
relaAddend :: WordXX c
..}) = do
    WordXX c -> Put
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 -> Word64 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (Word64 -> Put) -> Word64 -> Put
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word64
relaInfo64 Word32
relaSym Word32
relaType
        SingElfClass c
SELFCLASS32 -> Word32 -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putE (Word32 -> Put) -> Word32 -> Put
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32
relaInfo32 Word32
relaSym Word32
relaType) :: Put
    WordXX c -> 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 = SingElfClass a
-> (SingElfClassI a => RelaXX a -> Put) -> RelaXX a -> Put
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) ((forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX a -> Put
forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX c -> Put
putRelocationTableAEntry b -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putBe) (RelaXX a -> Put)
-> (Be (RelaXX a) -> RelaXX a) -> Be (RelaXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Be (RelaXX a) -> RelaXX a
forall a. Be a -> a
fromBe
    get :: Get (Be (RelaXX a))
get = RelaXX a -> Be (RelaXX a)
forall a. a -> Be a
Be (RelaXX a -> Be (RelaXX a))
-> Get (RelaXX a) -> Get (Be (RelaXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SingElfClass a
-> (SingElfClassI a => Get (RelaXX a)) -> Get (RelaXX a)
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) ((forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX a)
forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX c)
getRelocationTableAEntry Get b
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 = SingElfClass a
-> (SingElfClassI a => RelaXX a -> Put) -> RelaXX a -> Put
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) ((forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX a -> Put
forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => b -> Put)
-> RelaXX c -> Put
putRelocationTableAEntry b -> Put
forall b. (Binary (Le b), Binary (Be b)) => b -> Put
putLe) (RelaXX a -> Put)
-> (Le (RelaXX a) -> RelaXX a) -> Le (RelaXX a) -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Le (RelaXX a) -> RelaXX a
forall a. Le a -> a
fromLe
    get :: Get (Le (RelaXX a))
get = RelaXX a -> Le (RelaXX a)
forall a. a -> Le a
Le (RelaXX a -> Le (RelaXX a))
-> Get (RelaXX a) -> Get (Le (RelaXX a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SingElfClass a
-> (SingElfClassI a => Get (RelaXX a)) -> Get (RelaXX a)
forall (c :: ElfClass) r.
SingElfClass c -> (SingElfClassI c => r) -> r
withSingElfClassI (forall (c :: ElfClass). SingElfClassI c => SingElfClass c
singElfClass @a) ((forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX a)
forall (c :: ElfClass).
SingElfClassI c =>
(forall b. (Binary (Le b), Binary (Be b)) => Get b)
-> Get (RelaXX c)
getRelocationTableAEntry Get b
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 = Int64 -> WordXX a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> WordXX a) -> Int64 -> WordXX a
forall a b. (a -> b) -> a -> b
$ ByteString -> Int64
BSL.length (ByteString -> Int64) -> ByteString -> Int64
forall a b. (a -> b) -> a -> b
$ Le (RelaXX a) -> ByteString
forall a. Binary a => a -> ByteString
encode (Le (RelaXX a) -> ByteString) -> Le (RelaXX a) -> ByteString
forall a b. (a -> b) -> a -> b
$ RelaXX a -> Le (RelaXX a)
forall a. a -> Le a
Le (RelaXX a -> Le (RelaXX a)) -> RelaXX a -> Le (RelaXX a)
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 ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
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
Loc -> String -> m (Int64, a)
forall (m :: * -> *) a. MonadThrow m => Loc -> String -> m a
chainedError (String -> m (Int64, a)) -> String -> m (Int64, a)
forall a b. (a -> b) -> a -> b
$ String
err String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" @" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int64 -> String
forall a. Show a => a -> String
show Int64
off
    Right (ByteString
_, Int64
off, a
a) -> (Int64, a) -> m (Int64, a)
forall a. a -> m 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 = (Int64, a) -> a
forall a b. (a, b) -> b
snd ((Int64, a) -> a) -> m (Int64, a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m (Int64, a)
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
    (off, a) <- ByteString -> m (Int64, a)
forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m (Int64, a)
elfDecodeOrFail' ByteString
bs
    if off == BSL.length bs then return a else $chainedError $ "leftover != 0 @" ++ show 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 -> BList a -> [a]
forall a. BList a -> [a]
fromBList (BList a -> [a])
-> (Le (BList a) -> BList a) -> Le (BList a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Le (BList a) -> BList a
forall a. Le a -> a
fromLe (Le (BList a) -> [a]) -> m (Le (BList a)) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m (Le (BList a))
forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m a
elfDecodeAllOrFail ByteString
bs
    ElfData
ELFDATA2MSB -> BList a -> [a]
forall a. BList a -> [a]
fromBList (BList a -> [a])
-> (Be (BList a) -> BList a) -> Be (BList a) -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Be (BList a) -> BList a
forall a. Be a -> a
fromBe (Be (BList a) -> [a]) -> m (Be (BList a)) -> m [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> m (Be (BList a))
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 -> Le (BList a) -> ByteString
forall a. Binary a => a -> ByteString
encode (Le (BList a) -> ByteString) -> Le (BList a) -> ByteString
forall a b. (a -> b) -> a -> b
$ BList a -> Le (BList a)
forall a. a -> Le a
Le (BList a -> Le (BList a)) -> BList a -> Le (BList a)
forall a b. (a -> b) -> a -> b
$ [a] -> BList a
forall a. [a] -> BList a
BList [a]
as
    ElfData
ELFDATA2MSB -> Be (BList a) -> ByteString
forall a. Binary a => a -> ByteString
encode (Be (BList a) -> ByteString) -> Be (BList a) -> ByteString
forall a b. (a -> b) -> a -> b
$ BList a -> Be (BList a)
forall a. a -> Be a
Be (BList a -> Be (BList a)) -> BList a -> Be (BList a)
forall a b. (a -> b) -> a -> b
$ [a] -> BList a
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
hData :: forall (c :: ElfClass). HeaderXX c -> ElfData
hOSABI :: forall (c :: ElfClass). HeaderXX c -> ElfOSABI
hABIVersion :: forall (c :: ElfClass). HeaderXX c -> Word8
hType :: forall (c :: ElfClass). HeaderXX c -> ElfType
hMachine :: forall (c :: ElfClass). HeaderXX c -> ElfMachine
hEntry :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hPhOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hShOff :: forall (c :: ElfClass). HeaderXX c -> WordXX c
hFlags :: forall (c :: ElfClass). HeaderXX c -> Word32
hPhEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hPhNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShEntSize :: forall (c :: ElfClass). HeaderXX c -> Word16
hShNum :: forall (c :: ElfClass). HeaderXX c -> Word16
hShStrNdx :: forall (c :: ElfClass). HeaderXX c -> ElfSectionIndex
hData :: ElfData
hOSABI :: ElfOSABI
hABIVersion :: Word8
hType :: ElfType
hMachine :: ElfMachine
hEntry :: WordXX a
hPhOff :: WordXX a
hShOff :: WordXX a
hFlags :: Word32
hPhEntSize :: Word16
hPhNum :: Word16
hShEntSize :: Word16
hShNum :: Word16
hShStrNdx :: ElfSectionIndex
..} ByteString
bs =
    let
        takeLen :: WordXX a -> Word16 -> ByteString
takeLen WordXX a
off Word16
len = Int64 -> ByteString -> ByteString
BSL.take (Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
len) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop (WordXX a -> Int64
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 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
hShNum)
        bsSegments :: ByteString
bsSegments = WordXX a -> Word16 -> ByteString
takeLen WordXX a
hPhOff (Word16
hPhEntSize Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
* Word16
hPhNum)
    in do
        ss <- ElfData -> ByteString -> m [SectionXX a]
forall (m :: * -> *) a.
(MonadThrow m, Binary (Le a), Binary (Be a)) =>
ElfData -> ByteString -> m [a]
parseBList ElfData
hData ByteString
bsSections
        ps <- parseBList hData bsSegments
        return $ Headers singElfClass hxx ss 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 classS hxx <- ByteString -> m Header
forall a (m :: * -> *).
(Binary a, MonadThrow m) =>
ByteString -> m a
elfDecodeOrFail ByteString
bs
    withSingElfClassI classS parseHeaders' hxx 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 (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BSL.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteString -> ByteString
BSL.drop Int64
offset ByteString
bs