hurdle 0.1.0 → 0.2.0
raw patch · 7 files changed
+286/−384 lines, 7 filesdep +containersdep +kangaroodep ~array
Dependencies added: containers, kangaroo
Dependency ranges changed: array
Files
- hurdle.cabal +22/−11
- src/Hurdle/Datatypes.hs +17/−4
- src/Hurdle/DefOutput.hs +14/−5
- src/Hurdle/ParseMonad.hs +0/−238
- src/Hurdle/Parser.hs +156/−122
- src/Hurdle/TextDump.hs +5/−4
- src/Hurdle/Utils.hs +72/−0
hurdle.cabal view
@@ -1,5 +1,5 @@ name: hurdle-version: 0.1.0+version: 0.2.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley <stephen.tetley@gmail.com>@@ -12,32 +12,43 @@ . Extract function names from Windows DLLs a-la pexports. . - Hurdle has minimal dependencies: base, array and pretty.+ Hurdle has minimal dependencies: base, containers, pretty and + kangaroo (kangaroo just needs base and array). . Currently Hurdle also has minimal utility - please consider pexports instead as Hurdle doesn't yet print ordinals - etcetera (Hurdle was a Sunday afternoon hack that took a wee - bit longer). But... if anyone has a compelling use case that - would benefit the community, I'm willing to look at extending - Hurdle.+ and fails on DLLs generated by Visual C++ (Hurdle was a Sunday + afternoon hack that took a wee bit longer). But... if anyone + has a compelling use case that would benefit the community, I'm + willing to look at extending Hurdle. .+ Change-log+ .+ 0.1.0 to 0.2.0 + .+ * Changed to use kangaroo binary parser combinators.+ * Added error message reporting parser failure when + .edata section is not found.+ .+ build-type: Simple stability: unstable cabal-version: >= 1.2 Executable hurdle Build-Depends: base < 5, - array >= 0.2.0.0 && < 0.3,- pretty + array >= 0.2.0.0 && < 0.4,+ containers, + pretty,+ kangaroo >= 0.1.0 && < 0.2 Main-Is: Hurdle.hs Hs-Source-Dirs: src Other-Modules: Hurdle.Datatypes, Hurdle.DefOutput,- Hurdle.ParseMonad, Hurdle.Parser,- Hurdle.TextDump- + Hurdle.TextDump,+ Hurdle.Utils
src/Hurdle/Datatypes.hs view
@@ -16,6 +16,7 @@ module Hurdle.Datatypes where +import Data.Map ( Map ) import Data.Word data Image = Image @@ -23,8 +24,8 @@ , image_signature :: (Char,Char,Char,Char) , image_coff_header :: ImageCOFFHeader , image_opt_header :: ImageOptionalHeader- , image_section_headers :: [SectionHeader]- , image_export_data :: ExportData+ , image_section_headers :: SectionHeaders+ , image_export_data :: Maybe ExportData } deriving Show @@ -136,6 +137,9 @@ } deriving Show ++type SectionHeaders = Map String SectionHeader+ data SectionHeader = SectionHeader { sh_name :: String -- 8 bytes , sh_virtual_size :: Word32@@ -154,7 +158,7 @@ -- name_ptrs and ordinals should be zipped... data ExportData = ExportData { ed_directory_table :: ExportDirectoryTable- , ed_export_address_table :: [ExportAddress]+ , ed_export_address_table :: ExportAddressTable , ed_name_ptr_table :: [Word32] , ed_ordinal_table :: [Word16] , ed_dll_name :: String@@ -177,7 +181,16 @@ } deriving Show - +newtype ExportAddressTable = ExportAddressTable + { getExportAddressTable :: [ExportAddress] }+ deriving Show++ data ExportAddress = EA_Export_RVA Word32 | EA_Forwarder_RVA Word32 deriving Show+++++
src/Hurdle/DefOutput.hs view
@@ -28,9 +28,18 @@ defs :: Image -> Doc-defs a = text "LIBRARY" <+> text (ed_dll_name $ image_export_data a)- $+$ text "EXPORTS"- $+$ outputExports ( image_export_data a)+defs = maybe failureMessage exportData . image_export_data -outputExports :: ExportData -> Doc-outputExports = vcat . map text . ed_name_table++exportData :: ExportData -> Doc+exportData a = + text "LIBRARY" <+> text (ed_dll_name a)+ $+$ text "EXPORTS"+ $+$ (vcat $ map text $ ed_name_table a)+++failureMessage :: Doc+failureMessage = + text "--- ERROR - .edata section not found in file ---"+ $+$ text "--- please use pexports for this file... ---" +
− src/Hurdle/ParseMonad.hs
@@ -1,238 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Hurdle.ParseMonad--- Copyright : (c) Stephen Tetley 2009--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- Stability : highly unstable--- Portability : to be determined.------ Random access parse monad --------------------------------------------------------------------------------------module Hurdle.ParseMonad where--import Control.Applicative-import Control.Monad-import Data.Array.IO-import Data.Bits-import Data.Char-import Data.Int-import Data.Word-import System.IO--type ParseErr = String--type ImageData = IOUArray Int Word8 -- Is Int big enough for index?--type St = Int -- 'file' position-type Env = ImageData- --newtype Parser a = Parser { - getParser :: Env -> St -> IO (St,Either ParseErr a) }- -instance Functor Parser where- fmap f (Parser x) = Parser $ - \env st -> x env st `bindIO` \(st',a) -> return (st',fmap f a)--bindIO :: IO a -> (a -> IO b) -> IO b-bindIO = (>>=)--returnIO :: a -> IO a-returnIO = return---instance Monad Parser where- return a = Parser $ \_ st -> returnIO (st,Right a)- (Parser x) >>= f = Parser $ - \env st -> x env st `bindIO` \(st',ans) ->- case ans of - Left err -> returnIO (st',Left err)- Right a -> getParser (f a) env st'----instance Applicative Parser where- pure = return- (<*>) = ap---getSt :: Parser St-getSt = Parser $ \_ st -> return (st, Right st)--putSt :: St -> Parser ()-putSt st = Parser $ \_ _ -> return (st, Right ())--modifySt :: (St -> St) -> Parser ()-modifySt f = Parser $ \_ st -> return (f st, Right ())--askEnv :: Parser Env-askEnv = Parser $ \env st -> return (st, Right env)---throwErr :: String -> Parser a-throwErr msg = Parser $ \_ st -> return (st,Left msg)--liftIOAction :: IO a -> Parser a-liftIOAction ma = Parser $ \_ st -> ma >>= \a -> return (st,Right a) ---runParser :: Parser a -> FilePath -> IO (Either ParseErr a)-runParser p filename = withBinaryFile filename ReadMode $ \ handle -> do - sz' <- hFileSize handle- let sz = fromIntegral sz'- arr <- newArray_ (0,sz-1)- _rsz <- hGetArray handle arr (fromIntegral sz)- (_,ans) <- runP p arr- return ans - where - runP :: Parser a -> ImageData -> IO (St, Either ParseErr a) - runP (Parser x) arr = x arr 0-------------------------------------------------------------------------------------- --- -getWord8 :: Parser Word8-getWord8 = do- ix <- getSt- arr <- askEnv- a <- liftIOAction $ readArray arr ix- putSt $ ix+1- return a-------------------------------------------------------------------------------------- helpers---- | applicative cons-(<:>) :: Applicative f => f a -> f [a] -> f [a]-(<:>) p1 p2 = (:) <$> p1 <*> p2---jumpto :: Int -> Parser ()-jumpto = putSt---reportFail :: String -> Parser a-reportFail s = do - posn <- getSt- throwErr $ s ++ posStr posn- where- posStr p = " position " ++ show p --satisfy :: (Word8 -> Bool) -> Parser Word8-satisfy p = getWord8 >>= - (\x -> if p x then return x else reportFail $ "satisfy...")--try :: Parser a -> Parser a-try p = Parser $ \env st -> (getParser p) env st >>= \ ans -> - case ans of- (_,Left err) -> return (st,Left err)- okay -> return okay--opt :: Parser a -> Parser (Maybe a)-opt p = Parser $ \env st -> (getParser p) env st >>= \ ans -> - case ans of- (_, Left _) -> return (st, Right Nothing)- (st', Right a) -> return (st', Right $ Just a)--manyTill :: Parser a -> Parser b -> Parser [a]-manyTill p end = do - ans <- opt end- case ans of- Just _ -> return []- Nothing -> p <:> manyTill p end ---eof :: Parser Bool-eof = do- ix <- getSt- arr <- askEnv- (_,up) <- liftIOAction $ getBounds arr- return $ (ix>=up) ---- | Read a null-terminated string-cstring :: Parser String-cstring = manyTill char w8Zero---w8Zero :: Parser Word8-w8Zero = satisfy (==0)--getBytes :: Integral a => a -> Parser [Word8]-getBytes i = count (fromIntegral i) getWord8--char :: Parser Char-char = (chr . fromIntegral) <$> getWord8 --getChar8bit :: Parser Char-getChar8bit = (chr . fromIntegral) <$> getWord8 --filePosition :: Parser Int-filePosition = getSt---count :: Int -> Parser a -> Parser [a]-count i p = step i [] where- step n xs | n <= 0 = return (reverse xs)- | otherwise = p >>= \a -> step (n-1) (a:xs)- ---getInt8 :: Parser Int8-getInt8 = (fromIntegral . unwrap) <$> getWord8- where- unwrap :: Word8 -> Int- unwrap i | i > 128 = (fromIntegral i) - 256- | otherwise = fromIntegral i--getWord16be :: Parser Word16-getWord16be = w16be <$> getWord8 <*> getWord8 --getWord32be :: Parser Word32-getWord32be = w32be <$> getWord8 <*> getWord8 <*> getWord8 <*> getWord8--getWord16le :: Parser Word16-getWord16le = w16le <$> getWord8 <*> getWord8 --getWord32le :: Parser Word32-getWord32le = w32le <$> getWord8 <*> getWord8 <*> getWord8 <*> getWord8-- --w16be :: Word8 -> Word8 -> Word16-w16be a b = (shiftL8 a) + fromIntegral b- - -w32be :: Word8 -> Word8 -> Word8 -> Word8 -> Word32-w32be a b c d = (shiftL24 a) + (shiftL16 b) + (shiftL8 c) + fromIntegral d---w16le :: Word8 -> Word8 -> Word16-w16le a b = fromIntegral a + (shiftL8 b)--w32le :: Word8 -> Word8 -> Word8 -> Word8 -> Word32-w32le a b c d = fromIntegral a + (shiftL8 b) + (shiftL16 c) + (shiftL24 d) ----shiftL8 :: (Bits b, Integral b) => Word8 -> b-shiftL8 = (`shiftL` 8) . fromIntegral---shiftL16 :: (Bits b, Integral b) => Word8 -> b-shiftL16 = (`shiftL` 16) . fromIntegral---shiftL24 :: (Bits b, Integral b) => Word8 -> b-shiftL24 = (`shiftL` 24) . fromIntegral--
src/Hurdle/Parser.hs view
@@ -17,22 +17,31 @@ module Hurdle.Parser where import Hurdle.Datatypes-import Hurdle.ParseMonad+import Hurdle.Utils import Control.Applicative+import Control.Monad+import qualified Data.Map as Map import Data.Word-import System.IO readDLL :: FilePath -> IO Image-readDLL filename = do - ans <- runParser dllFile filename+readDLL filename = do+ (ans,w) <- runKangaroo dllFile filename case ans of - Left err -> putStrLn err >> error "readDLL failed"+ Left err -> (putStrLn $ toList w) >> error err Right mf -> return mf - +++infixr 5 <:>++-- | applicative cons+(<:>) :: Applicative f => f a -> f [a] -> f [a]+(<:>) p1 p2 = (:) <$> p1 <*> p2++ -------------------------------------------------------------------------------- -- @@ -44,27 +53,28 @@ sig <- signature coffH <- imageCOFFHeader optH <- imageOptionalHeader- secHs <- count (fromIntegral $ ich_num_sections coffH) sectionHeader- expH <- exportSectionHeader secHs- jumpto (fromIntegral $ sh_ptr_raw_data expH)- expD <- exportData expH+ secHs <- sectionHeaders (fromIntegral $ ich_num_sections coffH)+ opt_expos <- optExportData secHs return $ Image { image_dos_header = dosH , image_signature = sig , image_coff_header = coffH , image_opt_header = optH , image_section_headers = secHs- , image_export_data = expD+ , image_export_data = opt_expos } --- bit crummy...-exportSectionHeader :: [SectionHeader] -> Parser SectionHeader-exportSectionHeader (_:_:_:_:edata:_) = return $ edata-exportSectionHeader _ = reportFail "no .edata" +optExportData :: SectionHeaders -> Parser (Maybe ExportData)+optExportData = maybe (return Nothing) sk . Map.lookup ".edata" + where+ sk a = let raw_data = fromIntegral $ sh_ptr_raw_data a in+ liftM Just $ advanceAlfermataAbsolute raw_data (exportData a) ++ toNewExeHeader :: Word32 -> Parser () toNewExeHeader n = do - getBytes (n - dosHSize)+ _anon <- getBytes (n - dosHSize) return () where dosHSize = 0x0040@@ -72,51 +82,51 @@ imageDOSHeader :: Parser ImageDOSHeader imageDOSHeader = ImageDOSHeader <$> magic - <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le <*> reserved1- <*> getWord16le- <*> getWord16le+ <*> word16le+ <*> word16le <*> reserved2- <*> getWord32le+ <*> word32le where -- | Magic number 0x5a4d magic :: Parser Word16- magic = getWord16le+ magic = word16le reserved1 :: Parser (Word16,Word16,Word16,Word16)- reserved1 = (,,,) <$> getWord16le <*> getWord16le - <*> getWord16le <*> getWord16le+ reserved1 = (,,,) <$> word16le <*> word16le + <*> word16le <*> word16le reserved2 :: Parser [Word16]- reserved2 = count 10 getWord16le+ reserved2 = count 10 word16le signature :: Parser (Char,Char,Char,Char) -signature = (,,,) <$> getChar8bit <*> getChar8bit - <*> getChar8bit <*> getChar8bit+signature = (,,,) <$> char <*> char + <*> char <*> char imageCOFFHeader :: Parser ImageCOFFHeader imageCOFFHeader = ImageCOFFHeader <$> - getWord16le- <*> getWord16le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord16le- <*> getWord16le+ word16le+ <*> word16le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word16le+ <*> word16le imageOptionalHeader :: Parser ImageOptionalHeader@@ -128,90 +138,108 @@ imageOptionalStandard :: Parser ImageOptionalStandard imageOptionalStandard = ImageOptionalStandard <$>- getWord16le- <*> getWord8- <*> getWord8- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le+ word16le+ <*> word8+ <*> word8+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le imageOptionalNTSpecific :: Parser ImageOptionalNTSpecific imageOptionalNTSpecific = ImageOptionalNTSpecific <$>- getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord16le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord16le- <*> getWord16le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le+ word32le+ <*> word32le+ <*> word32le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word16le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word16le+ <*> word16le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le imageDataDirectory :: Parser ImageDataDirectory imageDataDirectory = ImageDataDirectory <$>- getWord32le- <*> getWord32le+ word32le+ <*> word32le +-- should be a Map then ++sectionHeaders :: Int -> Parser SectionHeaders+sectionHeaders n = build <$> count n sectionHeader+ where+ build = foldr (\e a -> Map.insert (sh_name e) e a) Map.empty++ sectionHeader :: Parser SectionHeader sectionHeader = SectionHeader <$>- count 8 getChar8bit- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord16le- <*> getWord16le- <*> getWord32le+ liftM stringTruncate (count 8 char) -- this should be a combinator+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word16le+ <*> word16le+ <*> word32le +jumpto :: Int -> Parser a -> Parser a+jumpto = advanceDalpuntoAbsolute++forwardParse :: (ExportDirectoryTable -> Word32)+ -> ExportDirectoryTable+ -> SectionHeader+ -> Parser a+ -> Parser a+forwardParse f edt section p = advanceDalpuntoAbsolute pos p+ where+ pos = fromIntegral $ rvaToOffset (f edt) section+ + -- At some point... I'll tidy this up. exportData :: SectionHeader -> Parser ExportData exportData section = do- edt <- exportDirectoryTable- let eac = fromIntegral $ edt_num_addr_table_entries edt- let ea_rva = fromIntegral $ - rvaToOffset (edt_export_addr_table_rva edt) section- jumpto ea_rva- ats <- count eac exportAddress+ logPosition "starting exportData..."+ edt <- exportDirectoryTable+ logline $ show edt - let enc = fromIntegral $ edt_num_name_ptrs edt- let en_rva = fromIntegral $ - rvaToOffset (edt_name_ptr_table_rva edt) section- jumpto en_rva- nptrs <- count enc getWord32le+ logPosition "export addr table"+ let eac = fromIntegral $ edt_num_addr_table_entries edt+ logline $ "num entries in export address table " ++ show eac - let eo_rva = fromIntegral $ - rvaToOffset (edt_ordinal_table_rva edt) section- jumpto eo_rva- ords <- count enc getWord16le+ ats <- forwardParse edt_export_addr_table_rva edt section+ (exportAddressTable eac) + logPosition "ptr_table"+ let enc = fromIntegral $ edt_num_name_ptrs edt+ nptrs <- forwardParse edt_name_ptr_table_rva edt section+ (count enc word32le)++ ords <- forwardParse edt_ordinal_table_rva edt section+ (count enc word16le)+ names <- exportNames section nptrs - let nm_rva = fromIntegral $ - rvaToOffset (edt_name_rva edt) section-- jumpto nm_rva- dllname <- cstring+ dllname <- forwardParse edt_name_rva edt section cstring return $ ExportData { ed_directory_table = edt , ed_export_address_table = ats@@ -223,30 +251,36 @@ exportDirectoryTable :: Parser ExportDirectoryTable exportDirectoryTable = ExportDirectoryTable <$>- getWord32le- <*> getWord32le- <*> getWord16le- <*> getWord16le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le- <*> getWord32le+ word32le+ <*> word32le+ <*> word16le+ <*> word16le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ <*> word32le+ `substError` "error - export directory table" ++exportAddressTable :: Int -> Parser ExportAddressTable+exportAddressTable n = ExportAddressTable <$> count n exportAddress + -- WRONG (for now) exportAddress :: Parser ExportAddress-exportAddress = EA_Export_RVA <$>- getWord32le+exportAddress = EA_Export_RVA <$> word32le + exportNames :: SectionHeader -> [Word32] -> Parser [String] exportNames _ [] = return [] exportNames section (x:xs) = mf <:> exportNames section xs where- mf = jumpto (fromIntegral $ rvaToOffset x section) >> cstring-+ mf = jumpto (fromIntegral $ rvaToOffset x section) cstring+ `substError` "export name..." + rvaToOffset :: Word32 -> SectionHeader -> Word32 rvaToOffset rva section = rva - (sh_virtual_addr section - sh_ptr_raw_data section)
src/Hurdle/TextDump.hs view
@@ -18,6 +18,7 @@ import Hurdle.Datatypes +import qualified Data.Map as Map import Data.Word import Numeric import Text.PrettyPrint.HughesPJ@@ -43,8 +44,8 @@ $+$ ppSignature (image_signature a) $+$ ppImageCOFFHeader (image_coff_header a) $+$ ppImageOptionalHeader (image_opt_header a)- $+$ (vcat $ map ppSectionHeader $ image_section_headers a)- $+$ ppExportData (image_export_data a)+ $+$ (vcat $ map ppSectionHeader $ Map.elems $ image_section_headers a)+ $+$ maybe empty ppExportData (image_export_data a) ppImageDOSHeader :: ImageDOSHeader -> Doc@@ -224,9 +225,9 @@ , ppf 8 "ordinal table rva" (ppHex 8 . edt_ordinal_table_rva) ] -ppExportAddressTable :: [ExportAddress] -> Doc+ppExportAddressTable :: ExportAddressTable -> Doc ppExportAddressTable a = - tableProlog "Export address" (24,6) (map field a)+ tableProlog "Export address" (24,6) (map field $ getExportAddressTable a) where ppf = ppField 4 24 field (EA_Export_RVA w32) = ppf 8 "export RVA" (ppHex 8) w32
+ src/Hurdle/Utils.hs view
@@ -0,0 +1,72 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Hurdle.Utils+-- Copyright : (c) Stephen Tetley 2009+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- +--+--------------------------------------------------------------------------------++module Hurdle.Utils + (+ module Data.ParserCombinators.KangarooWriter+ , Parser+ , H+ , toList+ , logline+ , logPosition++ , stringTruncate+ ) where+++import Data.ParserCombinators.KangarooWriter++import Data.Monoid++type Parser a = Kangaroo (H Char) a +++-- Hughes list - same as DList but we don't want a dependency++newtype H a = H { unH :: [a] -> [a] }++fromList :: [a] -> H a+fromList xs = H (xs++)++toList :: H a -> [a]+toList f = unH f []++append :: H a -> H a -> H a+append f g = H $ unH f . unH g++charH :: Char -> H Char+charH = fromList . return ++stringH :: String -> H Char+stringH = fromList++instance Monoid (H a) where+ mempty = fromList []+ mappend = append++logline :: String -> Parser ()+logline s = tell $ stringH s `append` charH '\n'+++logPosition :: String -> Parser ()+logPosition s = position >>= \pos -> + logline $ s ++ ", position " ++ show pos+++--------------------------------------------------------------------------------++stringTruncate :: String -> String+stringTruncate = takeWhile (/= '\NUL')