elna/lib/Language/Elna/Object/Elf.hs

module Language.Elna.Object.Elf
    ( Elf32_Addr
    , Elf32_Off
    , Elf32_Half
    , Elf32_Word
    , Elf32_Sword
    , Elf32_Ehdr(..)
    , Elf32_Shdr(..)
    , Elf32_Sym(..)
    , ElfIdentification(..)
    , ElfMachine(..)
    , ElfVersion(..)
    , ElfType(..)
    , ElfClass(..)
    , ElfData(..)
    , elf32Addr
    , elf32Half
    , elf32Off
    , elf32Shdr
    , elf32Sword
    , elf32Word
    , elf32Ehdr
    , elf32Sym
    , elfIdentification
    ) where

import qualified Data.ByteString.Builder as ByteString.Builder
import Data.Int (Int32)
import Data.Word (Word8, Word16, Word32)
import qualified Data.ByteString as ByteString

-- * Data types.

type Elf32_Addr = Word32 -- ^ Unsigned program address.
type Elf32_Half = Word16 -- ^ Unsigned medium integer.
type Elf32_Off = Word32 -- ^ Unsigned file offset.
type Elf32_Sword = Int32 -- ^ Signed large integer.
type Elf32_Word = Word32 -- ^ Unsigned large integer.

data ElfClass
    = ELFCLASSNONE -- ^ Invalid class.
    | ELFCLASS32 -- ^ 32-bit objects.
    | ELFCLASS64 -- ^ 64-bit objects.
    deriving Eq

instance Show ElfClass
  where
    show ELFCLASSNONE = "ELFCLASSNONE"
    show ELFCLASS32 = "ELFCLASS32"
    show ELFCLASS64 = "ELFCLASS64"

instance Enum ElfClass
  where
    toEnum 0 = ELFCLASSNONE
    toEnum 1 = ELFCLASS32
    toEnum 2 = ELFCLASS64
    toEnum _ = error "Unknown Elf class"
    fromEnum ELFCLASSNONE = 0
    fromEnum ELFCLASS32 = 1
    fromEnum ELFCLASS64 = 1

-- | Data encoding.
data ElfData
    = ELFDATANONE 
    | ELFDATA2LSB
    | ELFDATA2MSB
    deriving Eq

instance Show ElfData
  where
    show ELFDATANONE = "ELFDATANONE"
    show ELFDATA2LSB = "ELFDATA2LSB"
    show ELFDATA2MSB = "ELFDATA2MSB"

instance Enum ElfData
  where
    toEnum 0 = ELFDATANONE
    toEnum 1 = ELFDATA2LSB
    toEnum 2 = ELFDATA2MSB
    toEnum _ = error "Unknown elf data"
    fromEnum ELFDATANONE = 0
    fromEnum ELFDATA2LSB = 1
    fromEnum ELFDATA2MSB = 2

data ElfIdentification = ElfIdentification ElfClass ElfData
    deriving Eq

-- | ELF header.
data Elf32_Ehdr = Elf32_Ehdr
    { e_ident :: ElfIdentification
    , e_type :: ElfType
    , e_machine :: ElfMachine
    , e_version :: ElfVersion
    , e_entry :: Elf32_Addr
    , e_phoff :: Elf32_Off
    , e_shoff :: Elf32_Off
    , e_flags :: Elf32_Word
    , e_ehsize :: Elf32_Half
    , e_phentsize :: Elf32_Half
    , e_phnum :: Elf32_Half
    , e_shentsize :: Elf32_Half
    , e_shnum :: Elf32_Half
    , e_shstrndx :: Elf32_Half
    } deriving Eq

-- | Section header.
data Elf32_Shdr = Elf32_Shdr
    { sh_name :: Elf32_Word
    , sh_type :: Elf32_Word
    , sh_flags :: Elf32_Word
    , sh_addr :: Elf32_Addr
    , sh_offset :: Elf32_Off
    , sh_size :: Elf32_Word
    , sh_link :: Elf32_Word
    , sh_info :: Elf32_Word
    , sh_addralign :: Elf32_Word
    , sh_entsize :: Elf32_Word
    } deriving Eq

data ElfMachine
    = EM_NONE -- ^ No machine.
    | EM_M32 -- ^ AT&T WE 32100.
    | EM_SPARC -- ^ SPARC.
    | EM_386 -- ^ Intel Architecture.
    | EM_68K -- ^ Motorola 68000.
    | EM_88K -- ^ Motorola 88000.
    | EM_860 -- ^ Intel 80860.
    | EM_MIPS -- ^ MIPS RS3000 Big-Endian.
    | EM_MIPS_RS4_BE -- ^ MIPS RS4000 Big-Endian.
    deriving Eq

instance Enum ElfMachine
  where
    toEnum 0 = EM_NONE
    toEnum 1 = EM_M32
    toEnum 2 = EM_SPARC
    toEnum 3 = EM_386
    toEnum 4 = EM_68K
    toEnum 5 = EM_88K
    toEnum 7 = EM_860
    toEnum 8 = EM_MIPS
    toEnum 10 = EM_MIPS_RS4_BE
    toEnum _ = error "Unknown Elf machine"
    fromEnum EM_NONE = 0
    fromEnum EM_M32 = 1
    fromEnum EM_SPARC = 2
    fromEnum EM_386 = 3
    fromEnum EM_68K = 4
    fromEnum EM_88K = 5
    fromEnum EM_860 = 7
    fromEnum EM_MIPS = 8
    fromEnum EM_MIPS_RS4_BE = 10

data ElfVersion
    = EV_NONE -- ^ Invalid versionn.
    | EV_CURRENT -- ^ Current version.
    deriving Eq

instance Enum ElfVersion
  where
    toEnum 0 = EV_NONE
    toEnum 1 = EV_CURRENT
    toEnum _ = error "Unknown Elf version"
    fromEnum EV_NONE = 0
    fromEnum EV_CURRENT = 1

data ElfType
    = ET_NONE -- ^ No file type.
    | ET_REL -- ^ Relocatable file.
    | ET_EXEC -- ^ Executable file.
    | ET_DYN -- ^ Shared object file.
    | ET_CORE -- ^ Core file.
    | ET_LOPROC -- ^ Processor-specific.
    | ET_HIPROC -- ^ Processor-specific.
    deriving Eq

instance Enum ElfType
  where
    toEnum 0 = ET_NONE
    toEnum 1 = ET_REL
    toEnum 2 = ET_EXEC
    toEnum 3 = ET_DYN
    toEnum 4 = ET_CORE
    toEnum 0xff00 = ET_LOPROC
    toEnum 0xffff = ET_HIPROC
    toEnum _ = error "Unknown Elf type"
    fromEnum ET_NONE = 0
    fromEnum ET_REL = 1
    fromEnum ET_EXEC = 2
    fromEnum ET_DYN = 3
    fromEnum ET_CORE = 4
    fromEnum ET_LOPROC = 0xff00
    fromEnum ET_HIPROC = 0xffff

data Elf32_Sym = Elf32_Sym
    { st_name :: Elf32_Word
    , st_value :: Elf32_Addr
    , st_size :: Elf32_Word
    , st_info :: Word8
    , st_other :: Word8
    , st_shndx :: Elf32_Half 
    } deriving Eq

-- * Help types.

data ByteOrder = LSB | MSB
    deriving Eq

data ElfEncodingError
    = ElfInvalidByteOrderError
    | ElfUnsupportedClassError ElfClass
    deriving Eq

instance Show ElfEncodingError
  where
    show ElfInvalidByteOrderError = "Invalid byte order."
    show (ElfUnsupportedClassError class') =
        concat ["Elf class \"", show class', "\" is not supported."]

-- * Encoding functions.

elf32Addr :: ByteOrder -> Elf32_Addr -> ByteString.Builder.Builder
elf32Addr LSB = ByteString.Builder.word32LE
elf32Addr MSB = ByteString.Builder.word32BE

elf32Half :: ByteOrder -> Elf32_Half -> ByteString.Builder.Builder
elf32Half LSB = ByteString.Builder.word16LE
elf32Half MSB = ByteString.Builder.word16BE

elf32Off :: ByteOrder -> Elf32_Off -> ByteString.Builder.Builder
elf32Off LSB = ByteString.Builder.word32LE
elf32Off MSB = ByteString.Builder.word32BE

elf32Sword :: ByteOrder -> Elf32_Sword -> ByteString.Builder.Builder
elf32Sword LSB = ByteString.Builder.int32LE
elf32Sword MSB = ByteString.Builder.int32BE

elf32Word :: ByteOrder -> Elf32_Word -> ByteString.Builder.Builder
elf32Word LSB = ByteString.Builder.word32LE
elf32Word MSB = ByteString.Builder.word32BE

elfIdentification :: ElfIdentification -> ByteString.Builder.Builder
elfIdentification (ElfIdentification elfClass elfData)
    = ByteString.Builder.word8 0x7f
    <> ByteString.Builder.string7 "ELF"
    <> ByteString.Builder.word8 (fromIntegral $ fromEnum elfClass)
    <> ByteString.Builder.word8 (fromIntegral $ fromEnum elfData)
    <> ByteString.Builder.word8 (fromIntegral $ fromEnum EV_CURRENT)
    <> ByteString.Builder.byteString (ByteString.replicate 9 0)

elf32Ehdr :: Elf32_Ehdr -> Either ElfEncodingError ByteString.Builder.Builder
elf32Ehdr Elf32_Ehdr{..} = encode <$> byteOrder
  where
    encode byteOrder'
        = elfIdentification e_ident
        <> elf32Half byteOrder' (fromIntegral $ fromEnum e_type)
        <> elf32Half byteOrder' (fromIntegral $ fromEnum e_machine)
        <> elf32Word byteOrder' (fromIntegral $ fromEnum e_version)
        <> elf32Addr byteOrder' e_entry
        <> elf32Off byteOrder' e_phoff
        <> elf32Off byteOrder' e_shoff
        <> elf32Word byteOrder' e_flags
        <> elf32Half byteOrder' e_ehsize
        <> elf32Half byteOrder' e_phentsize
        <> elf32Half byteOrder' e_phnum
        <> elf32Half byteOrder' e_shentsize
        <> elf32Half byteOrder' e_shnum
        <> elf32Half byteOrder' e_shstrndx
    byteOrder
        | ElfIdentification class' _ <- e_ident
        , class' /= ELFCLASS32 = Left $ ElfUnsupportedClassError class'
        | ElfIdentification _ ELFDATA2MSB <- e_ident = Right MSB
        | ElfIdentification _ ELFDATA2LSB <- e_ident = Right LSB
        | ElfIdentification _ ELFDATANONE <- e_ident = Left ElfInvalidByteOrderError

elf32Shdr :: ByteOrder -> Elf32_Shdr -> ByteString.Builder.Builder
elf32Shdr byteOrder Elf32_Shdr{..}
    = elf32Word byteOrder sh_name
    <> elf32Word byteOrder sh_type
    <> elf32Word byteOrder sh_flags
    <> elf32Addr byteOrder sh_addr
    <> elf32Off byteOrder sh_offset
    <> elf32Word byteOrder sh_size
    <> elf32Word byteOrder sh_link
    <> elf32Word byteOrder sh_info
    <> elf32Word byteOrder sh_addralign
    <> elf32Word byteOrder sh_entsize

elf32Sym :: ByteOrder -> Elf32_Sym -> ByteString.Builder.Builder
elf32Sym byteOrder Elf32_Sym{..}
    = elf32Word byteOrder st_name
    <> elf32Addr byteOrder st_value
    <> elf32Word byteOrder st_size
    <> ByteString.Builder.word8 st_info
    <> ByteString.Builder.word8 st_other
    <> elf32Half byteOrder st_shndx