diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -3,4 +3,4 @@ main = defaultMainWithHooks $ simpleUserHooks { runTests = runElfTests } -runElfTests a b pd lb = system "runhaskell -i./src ./tests/ElfTest.hs" >> return () +runElfTests a b pd lb = system "runhaskell -i./src ./tests/Test.hs" >> return () diff --git a/elf.cabal b/elf.cabal --- a/elf.cabal +++ b/elf.cabal @@ -1,5 +1,5 @@ Name: elf -Version: 0.1 +Version: 0.2 License: BSD3 License-file: LICENSE Category: Data @@ -12,9 +12,9 @@ Build-Type: Custom Synopsis: Parser for ELF object format. Description: Parser for ELF object format. -Data-Files: tests/*.elf tests/ElfTest.hs +Data-Files: tests/empty.elf tests/Test.hs library - build-depends: base, bytestring, containers, binary + build-depends: base, bytestring, binary hs-source-dirs: src exposed-modules: Data.Elf diff --git a/src/Data/Elf.hs b/src/Data/Elf.hs --- a/src/Data/Elf.hs +++ b/src/Data/Elf.hs @@ -1,5 +1,14 @@ -- | Data.Elf is a module for parsing a ByteString of an ELF file into an Elf record. -module Data.Elf (getElf, Elf(..), ElfSection(..), ElfClass(..), ElfData(..), ElfOSABI(..), ElfType(..), ElfMachine(..)) where +module Data.Elf (parseElf + , Elf(..) + , ElfSection(..) + , ElfSectionType(..) + , ElfSectionFlags(..) + , ElfClass(..) + , ElfData(..) + , ElfOSABI(..) + , ElfType(..) + , ElfMachine(..)) where import Data.Binary import Data.Binary.Get @@ -11,8 +20,6 @@ import qualified Data.ByteString.Internal as B import qualified Data.ByteString.Lazy as L -import System.IO.Unsafe - data Elf = Elf { elfClass :: ElfClass -- ^ Identifies the class of the object file. , elfData :: ElfData -- ^ Identifies the data encoding of the object file. @@ -22,7 +29,7 @@ , elfType :: ElfType -- ^ Identifies the object file type. , elfMachine :: ElfMachine -- ^ Identifies the target architecture. , elfEntry :: Word64 -- ^ Virtual address of the program entry point. 0 for non-executable Elfs. - , elfSections :: [ElfSection] -- ^ Map from section name to section data. + , elfSections :: [ElfSection] -- ^ List of sections in the file. } deriving (Eq, Show) data ElfSection = ElfSection @@ -88,21 +95,15 @@ | SHF_EXECINSTR -- ^ Section contains executable instructions | SHF_EXT Int -- ^ Processor- or environment-specific flag deriving (Eq, Show) -getElfSectionFlags32 er = getWord32 er >>= return . getElfSectionFlags_ 31 - where getElfSectionFlags_ 0 word = [] - getElfSectionFlags_ 1 word | testBit word 1 = SHF_WRITE : getElfSectionFlags_ 0 word - getElfSectionFlags_ 2 word | testBit word 2 = SHF_ALLOC : getElfSectionFlags_ 1 word - getElfSectionFlags_ 3 word | testBit word 4 = SHF_EXECINSTR : getElfSectionFlags_ 2 word - getElfSectionFlags_ n word | testBit word n = SHF_EXT n : getElfSectionFlags_ (n-1) word - getElfSectionFlags_ n word = getElfSectionFlags_ (n-1) word -getElfSectionFlags64 er = getWord64 er >>= return . getElfSectionFlags_ 63 - where getElfSectionFlags_ 0 word = [] - getElfSectionFlags_ 1 word | testBit word 1 = SHF_WRITE : getElfSectionFlags_ 0 word - getElfSectionFlags_ 2 word | testBit word 2 = SHF_ALLOC : getElfSectionFlags_ 1 word - getElfSectionFlags_ 3 word | testBit word 4 = SHF_EXECINSTR : getElfSectionFlags_ 2 word - getElfSectionFlags_ n word | testBit word n = SHF_EXT n : getElfSectionFlags_ (n-1) word - getElfSectionFlags_ n word = getElfSectionFlags_ (n-1) word - +getElfSectionFlags 0 word = [] +getElfSectionFlags 1 word | testBit word 1 = SHF_WRITE : getElfSectionFlags 0 word +getElfSectionFlags 2 word | testBit word 2 = SHF_ALLOC : getElfSectionFlags 1 word +getElfSectionFlags 3 word | testBit word 4 = SHF_EXECINSTR : getElfSectionFlags 2 word +getElfSectionFlags n word | testBit word n = SHF_EXT n : getElfSectionFlags (n-1) word +getElfSectionFlags n word = getElfSectionFlags (n-1) word +getElfSectionFlags32 er = getWord32 er >>= return . getElfSectionFlags 31 +getElfSectionFlags64 er = getWord64 er >>= return . getElfSectionFlags 63 + data ElfClass = ELFCLASS32 -- ^ 32-bit ELF format | ELFCLASS64 -- ^ 64-bit ELF format @@ -503,9 +504,10 @@ divide bs s 0 = [] divide bs s n = let (x,y) = B.splitAt s bs in x:(divide y s (n-1)) --- | Parses a ByteString into an Elf record. An error is thrown for unrecognized ByteStrings. -getElf :: B.ByteString -> Elf -getElf b = +-- | Parses a ByteString into an Elf record. Parse failures call error. 32-bit ELF objects have their +-- fields promoted to 64-bit so that the 32- and 64-bit ELF records can be the same. +parseElf :: B.ByteString -> Elf +parseElf b = let (e, e_shoff, e_shentsize, e_shnum, e_shstrndx) = runGet getElf_Ehdr $ L.fromChunks [b] sh = B.take (fromIntegral (e_shentsize * e_shnum)) $ B.drop (fromIntegral e_shoff) b (shstroff, shstrsize) = runGet (getElf_Shdr_OffsetSize (elfClass e) (elfReader $ elfData e)) $ L.fromChunks [B.drop (fromIntegral (e_shentsize * e_shstrndx)) sh] diff --git a/tests/ElfTest.hs b/tests/ElfTest.hs deleted file mode 100644 --- a/tests/ElfTest.hs +++ /dev/null @@ -1,21 +0,0 @@ -module Main where - -import Data.Elf -import System.IO -import Test.HUnit -import Control.Monad -import qualified Control.Exception as E -import qualified Data.ByteString as B - -testEmptyElf = withBinaryFile "./tests/empty.elf" ReadMode $ \h -> do - fil <- B.hGetContents h - res <- E.try (E.evaluate (getElf fil)) :: IO (Either E.SomeException Elf) - case res of - Left e -> return () - Right a -> assertFailure "Empty ELF did not cause an exception." - -tests = TestList - [ TestLabel "Empty ELF" $ TestCase testEmptyElf - ] - -main = runTestTT tests diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,21 @@ +module Main where + +import Data.Elf +import System.IO +import Test.HUnit +import Control.Monad +import qualified Control.Exception as E +import qualified Data.ByteString as B + +testEmptyElf = withBinaryFile "./tests/empty.elf" ReadMode $ \h -> do + fil <- B.hGetContents h + res <- E.try (E.evaluate (parseElf fil)) :: IO (Either E.SomeException Elf) + case res of + Left e -> return () + Right a -> assertFailure "Empty ELF did not cause an exception." + +tests = TestList + [ TestLabel "Empty ELF" $ TestCase testEmptyElf + ] + +main = runTestTT tests