diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2008 Stephen Peter Tetley + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN +ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,4 @@ +#!/usr/bin/env runhaskell + +import Distribution.Simple +main = defaultMain diff --git a/hurdle.cabal b/hurdle.cabal new file mode 100644 --- /dev/null +++ b/hurdle.cabal @@ -0,0 +1,45 @@ +name: hurdle +version: 0.1.0 +license: BSD3 +license-file: LICENSE +copyright: Stephen Tetley +maintainer: Stephen Tetley +homepage: http://code.google.com/p/copperbox/ +category: System +synopsis: Extract function names from Windows DLLs. +description: + Hurdle - (H)askell (U)tilty (R)egarding (DL)l (E)xports. + . + Extract function names from Windows DLLs a-la pexports. + . + Hurdle has minimal dependencies: base, array and pretty. + . + 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. + . +build-type: Simple +stability: unstable +cabal-version: >= 1.2 + +Executable hurdle + Build-Depends: base < 5, + array >= 0.2.0.0 && < 0.3, + pretty + + Main-Is: Hurdle.hs + Hs-Source-Dirs: src + Other-Modules: Hurdle.Datatypes, + Hurdle.DefOutput, + Hurdle.ParseMonad, + Hurdle.Parser, + Hurdle.TextDump + + + + + + diff --git a/src/Hurdle.hs b/src/Hurdle.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle.hs @@ -0,0 +1,63 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : to be determined. +-- +-- main... +-- +-------------------------------------------------------------------------------- + +module Main where + +import Hurdle.Datatypes +import Hurdle.DefOutput +import Hurdle.Parser +import Hurdle.TextDump + +import System.Console.GetOpt +import System.Environment + +data Flag = Usage | Verbose + deriving (Eq, Show) + +header :: String +header = "Usage: pexports file" + +options :: [OptDescr Flag] +options = + [ Option ['h'] ["help"] (NoArg Usage) help_text + , Option ['v'] ["verbose"] (NoArg Verbose) verb_text + + ] + where + help_text = "please use pexports for the time being." + verb_text = "(very) verbose mode" +main :: IO () +main = do + args <- getArgs + let (opts, nonopts, errs) = getOpt Permute options args + main2 opts nonopts errs + + + +main2 :: [Flag] -> [FilePath] -> [String] -> IO () +main2 opts [fname] [] + | Usage `elem` opts = putStrLn $ usageInfo header options + | Verbose `elem` opts = run printImage fname + | otherwise = run printDef fname + +main2 _ _ _ = putStrLn $ "hurdle only handles one file at once." + +run :: (Image -> IO ()) -> FilePath -> IO () +run mf filename = do { img <- readDLL filename + ; mf img + ; putStrLn "" + } + diff --git a/src/Hurdle/Datatypes.hs b/src/Hurdle/Datatypes.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/Datatypes.hs @@ -0,0 +1,183 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.Datatypes +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : to be determined. +-- +-- +-- +-------------------------------------------------------------------------------- + +module Hurdle.Datatypes where + +import Data.Word + +data Image = Image + { image_dos_header :: ImageDOSHeader + , image_signature :: (Char,Char,Char,Char) + , image_coff_header :: ImageCOFFHeader + , image_opt_header :: ImageOptionalHeader + , image_section_headers :: [SectionHeader] + , image_export_data :: ExportData + } + deriving Show + +image_DOS_HEADER_size :: Int +image_DOS_HEADER_size = 64 + +data ImageDOSHeader = ImageDOSHeader + { idh_magic_number :: Word16 + , idh_bytes_last_page :: Word16 + , idh_pages_in_file :: Word16 + , idh_relocations :: Word16 + , idh_size_header_paras :: Word16 + , idh_min_extra_paras :: Word16 + , idh_max_extra_paras :: Word16 + , idh_initial_relative_ss :: Word16 + , idh_initial_sp :: Word16 + , idh_header_checksum :: Word16 + , idh_initial_ip :: Word16 + , idh_initial_relative_cs :: Word16 + , idh_reltable_file_addr :: Word16 + , idh_overlay_number :: Word16 + , idh_reserved_words :: (Word16,Word16,Word16,Word16) + , idh_oem_identifier :: Word16 + , idh_oem_info :: Word16 + , idh_reserved_words_two :: [Word16] -- length 10 + , idh_new_exe_header_addr :: Word32 + } + deriving Show + + + +image_COFF_HEADER_size :: Int +image_COFF_HEADER_size = 20 + +data ImageCOFFHeader = ImageCOFFHeader + { ich_machine :: Word16 + , ich_num_sections :: Word16 + , ich_timedate_stamp :: Word32 + , ich_sym_table_ptr :: Word32 + , ich_num_symbols :: Word32 + , ich_opt_header_size :: Word16 + , ich_characteristics :: Word16 + } + deriving Show + +image_OPTIONAL_HEADER_size :: Int +image_OPTIONAL_HEADER_size = + image_OPTIONAL_STANDARD_size + image_OPTIONAL_NT_SPECIFIC_size + + 16*image_DATA_DIRECTORY_size + +data ImageOptionalHeader = ImageOptionalHeader + { ioh_header_std_fields :: ImageOptionalStandard + , ioh_nt_specific_fields :: ImageOptionalNTSpecific + , ioh_data_directory :: [ImageDataDirectory] + } + deriving Show + + +image_OPTIONAL_STANDARD_size :: Int +image_OPTIONAL_STANDARD_size = 28 + +data ImageOptionalStandard = ImageOptionalStandard + { ios_magic :: Word16 + , ios_major_linker_version :: Word8 + , ios_minor_linker_version :: Word8 + , ios_size_of_code :: Word32 + , ios_size_of_inited_data :: Word32 + , ios_size_of_uninited_data :: Word32 + , ios_entry_point_addr :: Word32 + , ios_base_of_code :: Word32 + , ios_base_of_data :: Word32 + } + deriving Show + +image_OPTIONAL_NT_SPECIFIC_size :: Int +image_OPTIONAL_NT_SPECIFIC_size = 68 + +data ImageOptionalNTSpecific = ImageOptionalNTSpecific + { iont_image_base :: Word32 + , iont_section_alignment :: Word32 + , iont_file_alignment :: Word32 + , iont_major_os_version :: Word16 + , iont_minor_os_version :: Word16 + , iont_major_image_version :: Word16 + , iont_minor_image_version :: Word16 + , iont_major_subsys_version :: Word16 + , iont_minor_subsys_version :: Word16 + , iont_win32_version :: Word32 + , iont_size_of_image :: Word32 + , iont_size_of_headers :: Word32 + , iont_checksum :: Word32 + , iont_subsystem :: Word16 + , iont_dll_characteristics :: Word16 + , iont_size_stack_reserve :: Word32 + , iont_size_stack_commit :: Word32 + , iont_size_heap_reserve :: Word32 + , iont_size_heap_commit :: Word32 + , iont_loader_flags :: Word32 + , iont_rva_num_and_sizes :: Word32 + } + deriving Show + +image_DATA_DIRECTORY_size :: Int +image_DATA_DIRECTORY_size = 4 + +data ImageDataDirectory = ImageDataDirectory + { idd_virtual_addr :: Word32 + , idd_size :: Word32 + } + deriving Show + +data SectionHeader = SectionHeader + { sh_name :: String -- 8 bytes + , sh_virtual_size :: Word32 + , sh_virtual_addr :: Word32 + , sh_size_raw_data :: Word32 + , sh_ptr_raw_data :: Word32 + , sh_ptr_relocations :: Word32 + , sh_ptr_linenums :: Word32 + , sh_num_relocations :: Word16 + , sh_num_linenums :: Word16 + , sh_characteristics :: Word32 + } + deriving Show + +-- | \'.edata\' +-- name_ptrs and ordinals should be zipped... +data ExportData = ExportData + { ed_directory_table :: ExportDirectoryTable + , ed_export_address_table :: [ExportAddress] + , ed_name_ptr_table :: [Word32] + , ed_ordinal_table :: [Word16] + , ed_dll_name :: String + , ed_name_table :: [String] + } + deriving Show + +data ExportDirectoryTable = ExportDirectoryTable + { edt_export_flags :: Word32 + , edt_timedate_stamp :: Word32 + , edt_major_version :: Word16 + , edt_minor_version :: Word16 + , edt_name_rva :: Word32 + , edt_ordinal_base :: Word32 + , edt_num_addr_table_entries :: Word32 + , edt_num_name_ptrs :: Word32 + , edt_export_addr_table_rva :: Word32 + , edt_name_ptr_table_rva :: Word32 + , edt_ordinal_table_rva :: Word32 + } + deriving Show + + +data ExportAddress = EA_Export_RVA Word32 + | EA_Forwarder_RVA Word32 + deriving Show diff --git a/src/Hurdle/DefOutput.hs b/src/Hurdle/DefOutput.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/DefOutput.hs @@ -0,0 +1,36 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.DefOutput +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : +-- +-- Print in .def format +-- +-------------------------------------------------------------------------------- + +module Hurdle.DefOutput where + +import Hurdle.Datatypes + +import Text.PrettyPrint.HughesPJ + +printDef :: Image -> IO () +printDef = putStr . defText + +defText :: Image -> String +defText = renderStyle (Style PageMode 80 1.5) . defs + + +defs :: Image -> Doc +defs a = text "LIBRARY" <+> text (ed_dll_name $ image_export_data a) + $+$ text "EXPORTS" + $+$ outputExports ( image_export_data a) + +outputExports :: ExportData -> Doc +outputExports = vcat . map text . ed_name_table diff --git a/src/Hurdle/ParseMonad.hs b/src/Hurdle/ParseMonad.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/ParseMonad.hs @@ -0,0 +1,238 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.ParseMonad +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- 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 + + diff --git a/src/Hurdle/Parser.hs b/src/Hurdle/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/Parser.hs @@ -0,0 +1,252 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.Parser +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : to be determined. +-- +-- Read a DLL... +-- +-------------------------------------------------------------------------------- + +module Hurdle.Parser where + +import Hurdle.Datatypes +import Hurdle.ParseMonad + +import Control.Applicative +import Data.Word +import System.IO + + +readDLL :: FilePath -> IO Image +readDLL filename = do + ans <- runParser dllFile filename + case ans of + Left err -> putStrLn err >> error "readDLL failed" + Right mf -> return mf + + + +-------------------------------------------------------------------------------- +-- + + +dllFile :: Parser Image +dllFile = do + dosH <- imageDOSHeader + toNewExeHeader (idh_new_exe_header_addr dosH) + 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 + 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 + } + +-- bit crummy... +exportSectionHeader :: [SectionHeader] -> Parser SectionHeader +exportSectionHeader (_:_:_:_:edata:_) = return $ edata +exportSectionHeader _ = reportFail "no .edata" + + +toNewExeHeader :: Word32 -> Parser () +toNewExeHeader n = do + getBytes (n - dosHSize) + return () + where + dosHSize = 0x0040 + +imageDOSHeader :: Parser ImageDOSHeader +imageDOSHeader = ImageDOSHeader <$> + magic + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> getWord16le + <*> reserved1 + <*> getWord16le + <*> getWord16le + <*> reserved2 + <*> getWord32le + where + -- | Magic number 0x5a4d + + magic :: Parser Word16 + magic = getWord16le + + reserved1 :: Parser (Word16,Word16,Word16,Word16) + reserved1 = (,,,) <$> getWord16le <*> getWord16le + <*> getWord16le <*> getWord16le + + reserved2 :: Parser [Word16] + reserved2 = count 10 getWord16le + + +signature :: Parser (Char,Char,Char,Char) +signature = (,,,) <$> getChar8bit <*> getChar8bit + <*> getChar8bit <*> getChar8bit + +imageCOFFHeader :: Parser ImageCOFFHeader +imageCOFFHeader = ImageCOFFHeader <$> + getWord16le + <*> getWord16le + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord16le + <*> getWord16le + + +imageOptionalHeader :: Parser ImageOptionalHeader +imageOptionalHeader = ImageOptionalHeader <$> + imageOptionalStandard + <*> imageOptionalNTSpecific + <*> count 16 imageDataDirectory + + +imageOptionalStandard :: Parser ImageOptionalStandard +imageOptionalStandard = ImageOptionalStandard <$> + getWord16le + <*> getWord8 + <*> getWord8 + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord32le + +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 + + +imageDataDirectory :: Parser ImageDataDirectory +imageDataDirectory = ImageDataDirectory <$> + getWord32le + <*> getWord32le + + +sectionHeader :: Parser SectionHeader +sectionHeader = SectionHeader <$> + count 8 getChar8bit + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord16le + <*> getWord16le + <*> getWord32le + + +-- 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 + + 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 + + let eo_rva = fromIntegral $ + rvaToOffset (edt_ordinal_table_rva edt) section + jumpto eo_rva + ords <- count enc getWord16le + + names <- exportNames section nptrs + + let nm_rva = fromIntegral $ + rvaToOffset (edt_name_rva edt) section + + jumpto nm_rva + dllname <- cstring + + return $ ExportData { ed_directory_table = edt + , ed_export_address_table = ats + , ed_name_ptr_table = nptrs + , ed_ordinal_table = ords + , ed_dll_name = dllname + , ed_name_table = names + } + +exportDirectoryTable :: Parser ExportDirectoryTable +exportDirectoryTable = ExportDirectoryTable <$> + getWord32le + <*> getWord32le + <*> getWord16le + <*> getWord16le + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord32le + <*> getWord32le + +-- WRONG (for now) +exportAddress :: Parser ExportAddress +exportAddress = EA_Export_RVA <$> + getWord32le + +exportNames :: SectionHeader -> [Word32] -> Parser [String] +exportNames _ [] = return [] +exportNames section (x:xs) = mf <:> exportNames section xs + where + mf = jumpto (fromIntegral $ rvaToOffset x section) >> cstring + + +rvaToOffset :: Word32 -> SectionHeader -> Word32 +rvaToOffset rva section = + rva - (sh_virtual_addr section - sh_ptr_raw_data section) diff --git a/src/Hurdle/TextDump.hs b/src/Hurdle/TextDump.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/TextDump.hs @@ -0,0 +1,295 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.TextDump +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- Stability : highly unstable +-- Portability : +-- +-- Pretty print as text... +-- +-------------------------------------------------------------------------------- + +module Hurdle.TextDump where + +import Hurdle.Datatypes + +import Data.Word +import Numeric +import Text.PrettyPrint.HughesPJ + + +-- applyfs is 'sequence' from Control.Monad but I don't to drag in +-- Control.Monad.Instances +-- +applyfs :: [(a -> b)] -> a -> [b] +applyfs [] _ = [] +applyfs (f:fs) a = f a : applyfs fs a + +printImage :: Image -> IO () +printImage = putStr . imageText + +imageText :: Image -> String +imageText = renderStyle (Style PageMode 80 1.5) . ppImage + +ppImage :: Image -> Doc +ppImage a = + ppImageDOSHeader (image_dos_header a) + $+$ columnSep + $+$ 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) + + +ppImageDOSHeader :: ImageDOSHeader -> Doc +ppImageDOSHeader a = + tableProlog "IMAGE_DOS_HEADER" (24,6) (applyfs fields a) + where + ppf = ppField 4 24 + fields = + [ ppf 2 "magic" (ppHex 4 . idh_magic_number) + , ppf 2 "bytes last page" (ppHex 4 . idh_bytes_last_page) + , ppf 2 "pages in file" (ppHex 4 . idh_pages_in_file) + , ppf 2 "relocations" (ppHex 4 . idh_relocations) + , ppf 2 "header para size" (ppHex 4 . idh_size_header_paras) + , ppf 2 "min extra paragraphs" (ppHex 4 . idh_min_extra_paras) + , ppf 2 "max extra paragraphs" (ppHex 4 . idh_max_extra_paras) + , ppf 2 "initial SS value" (ppHex 4 . idh_initial_relative_ss) + , ppf 2 "initial SP value" (ppHex 4 . idh_initial_sp) + , ppf 2 "checksum" (ppHex 4 . idh_header_checksum) + + , ppf 2 "initial IP value" (ppHex 4 . idh_initial_ip) + , ppf 2 "initial CS value" (ppHex 4 . idh_initial_relative_cs) + , ppf 2 "relocation table addr" (ppHex 4 . idh_reltable_file_addr) + , ppf 2 "overlay number" (ppHex 4 . idh_overlay_number) + , ppf 8 "reserved 1" (tup4 . idh_reserved_words) + , ppf 2 "oem identifier" (ppHex 4 . idh_oem_identifier) + , ppf 2 "oem info" (ppHex 4 . idh_oem_info) + , ppf 20 "reserved 2" (text . show . idh_reserved_words_two) + , ppf 4 "new exe header addr" (ppHex 8 . idh_new_exe_header_addr) + ] + + tup4 (s,t,u,v) = text $ show [s,t,u,v] + +ppSignature :: (Char,Char,Char,Char) -> Doc +ppSignature (s,t,u,v) = + text "Signature:" <+> (listDoc $ map (text . show) [s,t,u,v]) + +ppImageCOFFHeader :: ImageCOFFHeader -> Doc +ppImageCOFFHeader a = + tableProlog "IMAGE COFF HEADER" (24,6) (applyfs fields a) + where + ppf = ppField 4 24 + fields = + [ ppf 2 "machine" (ppHex 4 . ich_machine) + , ppf 2 "num sections" (ppHex 4 . ich_num_sections) + , ppf 4 "timedatestamp" (ppHex 8 . ich_timedate_stamp) + , ppf 4 "ptr to sym table" (ppHex 8 . ich_sym_table_ptr) + , ppf 4 "num symbols" (ppHex 8 . ich_num_symbols) + , ppf 2 "size optional header" (ppHex 4 . ich_opt_header_size) + , ppf 2 "characteristics" (ppHex 4 . ich_characteristics) + ] + + +ppImageOptionalHeader :: ImageOptionalHeader -> Doc +ppImageOptionalHeader a = + ppImageOptionalStandard (ioh_header_std_fields a) + $+$ ppImageOptionalNTSpecific (ioh_nt_specific_fields a) + $+$ (vcat $ zipWith ppImageDataDirectory names (ioh_data_directory a)) + where + names = [ ".edata" + , ".idata" + , ".rsrc" + , ".pdata" + , "attribute certificate table" + , ".reloc" + , ".debug" + , "architecture" + , "global ptr" + , ".tls" + , "load config" + , "bound impact" + , "import address table" + , "delay import descriptor" + , ".cormeta" + , "reserved" + ] + +ppImageOptionalStandard :: ImageOptionalStandard -> Doc +ppImageOptionalStandard a = + tableProlog "IMAGE OPTIONAL HEADER STANDARD" (24,6) (applyfs fields a) + where + ppf = ppField 4 24 + fields = + [ ppf 2 "magic" (ppHex 4 . ios_magic) + , ppf 1 "major linker ver." (ppHex 2 . ios_major_linker_version) + , ppf 1 "minor linker ver." (ppHex 2 . ios_minor_linker_version) + , ppf 4 "size of code" (ppHex 8 . ios_size_of_code) + , ppf 4 "size of init. data" (ppHex 8 . ios_size_of_inited_data) + , ppf 4 "size of uninit. data" (ppHex 8 . ios_size_of_uninited_data) + , ppf 4 "entry ptr addr" (ppHex 8 . ios_entry_point_addr) + , ppf 4 "base of code" (ppHex 8 . ios_base_of_code) + , ppf 4 "base of data" (ppHex 8 . ios_base_of_data) + ] + + +ppImageOptionalNTSpecific :: ImageOptionalNTSpecific -> Doc +ppImageOptionalNTSpecific a = + tableProlog "IMAGE OPTIONAL HEADER NT SPECIFIC" (24,6) (applyfs fields a) + where + ppf = ppField 4 24 + fields = + [ ppf 4 "image base" (ppHex 8 . iont_image_base) + , ppf 4 "section alignment" (ppHex 8 . iont_section_alignment) + , ppf 4 "file alignment" (ppHex 8 . iont_file_alignment) + , ppf 2 "major os version" (ppHex 4 . iont_major_os_version) + , ppf 2 "minor os version" (ppHex 4 . iont_minor_os_version) + , ppf 2 "major image version" (ppHex 4 . iont_major_image_version) + , ppf 2 "minor image version" (ppHex 4 . iont_minor_image_version) + , ppf 2 "major subsys version" (ppHex 4 . iont_major_subsys_version) + , ppf 2 "minor subsys version" (ppHex 4 . iont_minor_subsys_version) + , ppf 4 "win32 version" (ppHex 8 . iont_win32_version) + , ppf 4 "size of image" (ppHex 8 . iont_size_of_image) + , ppf 4 "size of headers" (ppHex 8 . iont_size_of_headers) + , ppf 4 "checksum" (ppHex 8 . iont_checksum) + , ppf 2 "subsystem" (ppHex 4 . iont_subsystem) + , ppf 2 "dll characteristics" (ppHex 4 . iont_dll_characteristics) + , ppf 4 "size of stack reserve" (ppHex 8 . iont_size_stack_reserve) + , ppf 4 "size of stack commit" (ppHex 8 . iont_size_stack_commit) + , ppf 4 "size of heap reserve" (ppHex 8 . iont_size_heap_reserve) + , ppf 4 "size of heap commit" (ppHex 8 . iont_size_heap_commit) + , ppf 4 "loader flags" (ppHex 8 . iont_loader_flags) + , ppf 4 "rva num and sizes" (ppHex 8 . iont_rva_num_and_sizes) + ] + +ppImageDataDirectory :: String -> ImageDataDirectory -> Doc +ppImageDataDirectory s a = + tableProlog s (24,6) (applyfs fields a) + where + ppf = ppField 4 24 + fields = + [ ppf 4 "virtual address" (ppHex 8 . idd_virtual_addr) + , ppf 4 "size" (ppHex 8 . idd_size) + ] + + +ppSectionHeader :: SectionHeader -> Doc +ppSectionHeader a = + tableProlog "SECTION HEADER" (24,6) (applyfs fields a) + where + ppf = ppField 4 24 + fields = + [ ppf 8 "name" (text . sh_name) + , ppf 4 "virtual size" (ppHex 8 . sh_virtual_size) + , ppf 4 "virtual addr" (ppHex 8 . sh_virtual_addr) + , ppf 4 "size of raw data" (ppHex 8 . sh_size_raw_data) + , ppf 4 "ptr to raw data" (ppHex 8 . sh_ptr_raw_data) + , ppf 4 "ptr to relocations" (ppHex 8 . sh_ptr_relocations) + , ppf 4 "ptr to line numbers" (ppHex 8 . sh_ptr_linenums) + , ppf 2 "num of relocations" (ppHex 4 . sh_num_relocations) + , ppf 2 "num of line numbers" (ppHex 4 . sh_num_linenums) + , ppf 4 "characteristics" (ppHex 8 . sh_characteristics) + ] + +ppExportData :: ExportData -> Doc +ppExportData a = + ppExportDirectoryTable (ed_directory_table a) + $+$ ppExportAddressTable (ed_export_address_table a) + $+$ ppExportNamePtrTable (ed_name_ptr_table a) + $+$ ppExportOrdinalTable (ed_ordinal_table a) + $+$ ppExportNames (ed_name_table a) + +ppExportDirectoryTable :: ExportDirectoryTable -> Doc +ppExportDirectoryTable a = + tableProlog ".edata (Export directory table)" (24,6) (applyfs fields a) + where + ppf = ppField 4 24 + fields = + [ ppf 8 "export flags" (ppHex 8 . edt_export_flags) + , ppf 8 "timedate stamp" (ppHex 8 . edt_timedate_stamp) + , ppf 4 "major version" (ppHex 4 . edt_major_version) + , ppf 4 "minor version" (ppHex 4 . edt_minor_version) + , ppf 8 "name rva" (ppHex 8 . edt_name_rva) + , ppf 8 "oridinal base" (ppHex 8 . edt_ordinal_base) + , ppf 8 "addr table entries" (ppHex 8 . edt_num_addr_table_entries) + , ppf 8 "num name ptrs" (ppHex 8 . edt_num_name_ptrs) + , ppf 8 "export addr table rva" (ppHex 8 . edt_export_addr_table_rva) + , ppf 8 "name ptr rva" (ppHex 8 . edt_name_ptr_table_rva) + , ppf 8 "ordinal table rva" (ppHex 8 . edt_ordinal_table_rva) + ] + +ppExportAddressTable :: [ExportAddress] -> Doc +ppExportAddressTable a = + tableProlog "Export address" (24,6) (map field a) + where + ppf = ppField 4 24 + field (EA_Export_RVA w32) = ppf 8 "export RVA" (ppHex 8) w32 + field (EA_Forwarder_RVA w32) = ppf 8 "forwarder RVA" (ppHex 8) w32 + + +ppExportNamePtrTable :: [Word32] -> Doc +ppExportNamePtrTable a = + tableProlog "Export name pointers" (24,6) (map field a) + where + ppf = ppField 4 24 + field = ppf 8 "name ptr" (ppHex 8) + +ppExportOrdinalTable :: [Word16] -> Doc +ppExportOrdinalTable a = + tableProlog "Export ordinals" (24,6) (map field a) + where + ppf = ppField 4 24 + field = ppf 4 "ordinal" (ppHex 4) + +ppExportNames :: [String] -> Doc +ppExportNames a = + tableProlog "Export names" (24,6) (map field a) + where + ppf = ppField 4 24 + field = ppf 4 "export name" text + + + +-------------------------------------------------------------------------------- +-- Helpers + +tableProlog :: String -> (Int,Int) -> [Doc] -> Doc +tableProlog s (m,n) ds = + columnSep + $+$ text s + $+$ columnSep + $+$ columnHeadings m n + $+$ columnSep + $+$ vcat ds + where + columnHeadings fsz vsz = + text "size" <+> text (pad fsz ' ' "field") <+> text (pad vsz ' ' "value") + + +columnSep :: Doc +columnSep = text $ replicate 60 '-' + + +ppField :: Int -> Int -> Int -> String -> (a -> Doc) -> a -> Doc +ppField n1 n2 sz field_name f a = text sz' <+> text field_name' <+> f a + where + sz' = pad n1 ' ' (show sz) + field_name' = pad n2 ' ' field_name + +ppHex :: Integral a => Int -> a -> Doc +ppHex n i = text "0x" <> (text $ pad n '0' $ showHex i "") + + +pad :: Int -> Char -> String -> String +pad n ch s | length s < n = replicate (n - length s) ch ++ s + | otherwise = s + +listDoc :: [Doc] -> Doc +listDoc = brackets . hcat . punctuate comma +