hurdle 0.2.0 → 0.3.0
raw patch · 15 files changed
+1279/−913 lines, 15 filesdep −prettydep ~kangaroo
Dependencies removed: pretty
Dependency ranges changed: kangaroo
Files
- hurdle.cabal +23/−14
- src/Hurdle.hs +4/−4
- src/Hurdle/Ar/Datatypes.hs +54/−0
- src/Hurdle/Ar/Parser.hs +91/−0
- src/Hurdle/Ar/TextDump.hs +100/−0
- src/Hurdle/Base/Utils.hs +93/−0
- src/Hurdle/Coff/Datatypes.hs +186/−0
- src/Hurdle/Coff/DefOutput.hs +42/−0
- src/Hurdle/Coff/Parser.hs +389/−0
- src/Hurdle/Coff/TextDump.hs +297/−0
- src/Hurdle/Datatypes.hs +0/−196
- src/Hurdle/DefOutput.hs +0/−45
- src/Hurdle/Parser.hs +0/−286
- src/Hurdle/TextDump.hs +0/−296
- src/Hurdle/Utils.hs +0/−72
hurdle.cabal view
@@ -1,5 +1,5 @@ name: hurdle-version: 0.2.0+version: 0.3.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley <stephen.tetley@gmail.com>@@ -12,18 +12,24 @@ . Extract function names from Windows DLLs a-la pexports. . - Hurdle has minimal dependencies: base, containers, pretty and + Hurdle has minimal dependencies: base, containers, 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 - 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.+ pexports instead as Hurdle doesn't yet print ordinals and + fails on DLLs generated by Visual C++ (which puts function+ symbols in the .rdata section - gcc uses the .edata section). .+ Hurdle was a Sunday afternoon hack that has taken a good while+ longer...+ .+ . Change-log .+ 0.2.0 to 0.3.0+ .+ * Changes to use kangaroo-0.2.0+ . 0.1.0 to 0.2.0 . * Changed to use kangaroo binary parser combinators.@@ -39,16 +45,19 @@ Build-Depends: base < 5, array >= 0.2.0.0 && < 0.4, containers, - pretty,- kangaroo >= 0.1.0 && < 0.2 + kangaroo >= 0.2.0 && < 0.3 Main-Is: Hurdle.hs Hs-Source-Dirs: src- Other-Modules: Hurdle.Datatypes,- Hurdle.DefOutput,- Hurdle.Parser,- Hurdle.TextDump,- Hurdle.Utils + Other-Modules: Hurdle.Ar.Datatypes,+ Hurdle.Ar.Parser,+ Hurdle.Ar.TextDump,+ Hurdle.Base.Utils,+ Hurdle.Coff.Datatypes,+ Hurdle.Coff.DefOutput,+ Hurdle.Coff.Parser,+ Hurdle.Coff.TextDump+
src/Hurdle.hs view
@@ -16,10 +16,10 @@ module Main where -import Hurdle.Datatypes-import Hurdle.DefOutput-import Hurdle.Parser-import Hurdle.TextDump+import Hurdle.Coff.Datatypes+import Hurdle.Coff.DefOutput+import Hurdle.Coff.Parser+import Hurdle.Coff.TextDump import System.Console.GetOpt import System.Environment
+ src/Hurdle/Ar/Datatypes.hs view
@@ -0,0 +1,54 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Hurdle.Ar.Datatypes+-- Copyright : (c) Stephen Tetley 2009, 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- +--+--------------------------------------------------------------------------------++module Hurdle.Ar.Datatypes where++import qualified Data.ByteString as BSW8+import Data.Word++data ArArchive = ArArchive + { ar_magic :: String+ , ar_objects :: [ArchiveObject]+ }+ deriving Show+++data ArchiveObject = ArchiveObject+ { ar_header :: ArHeader+ , ar_body :: [Word8] -- needs thought... shouldn't be a list+ }++data ArHeader = ArHeader + { arh_name :: String+ , arh_date :: String+ , arh_user_id :: Int+ , arh_group_id :: Int+ , arh_mode :: String+ , arh_size :: Int+ , arh_trailer :: String+ } + deriving Show++++instance Show ArchiveObject where+ show (ArchiveObject h _) = "ArchiveObject " ++ show h++++++
+ src/Hurdle/Ar/Parser.hs view
@@ -0,0 +1,91 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Hurdle.Ar.Parser+-- Copyright : (c) Stephen Tetley 2009, 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- Read \".a\" archive...+--+--------------------------------------------------------------------------------++module Hurdle.Ar.Parser where++import Hurdle.Ar.Datatypes+import Hurdle.Base.Utils++import Control.Monad+import Data.Char++readAr :: FilePath -> IO ArArchive+readAr filename = do+ (ans,w) <- runKangaroo arArchive filename+ case ans of + Left err -> (putStrLn $ toList w) >> error err+ Right a -> return a+++++--------------------------------------------------------------------------------+-- + + +arArchive :: Parser ArArchive+arArchive = do+ magic <- arMagicString+ objects <- runOn archiveObject+ return $ ArArchive + { ar_magic = magic+ , ar_objects = objects+ }+++arMagicString :: Parser String+arMagicString = text 8 +++archiveObject :: Parser ArchiveObject+archiveObject = do + liftIOAction $ putStrLn "ao"+ header <- arHeader+ let sz = arh_size header+ liftIOAction $ putStrLn ("size " ++ show sz)+ body <- count sz word8+ pos <- position+ when (pos `mod` 2 /= 0) (char >> return ()) -- should be a newline + return $ ArchiveObject + { ar_header = header+ , ar_body = body+ }++paddedNumber :: (Read a, Integral a) => Int -> Parser a+paddedNumber i = liftM fn $ count i char+ where+ fn = read . takeWhile isDigit+++arHeader :: Parser ArHeader+arHeader = do + name <- text 16+ date <- text 12+ uid <- paddedNumber 6+ gid <- paddedNumber 6+ mode <- text 8+ size <- paddedNumber 10+ trailer <- text 2+ return $ ArHeader + { arh_name = name+ , arh_date = date+ , arh_user_id = uid+ , arh_group_id = gid+ , arh_mode = mode+ , arh_size = size+ , arh_trailer = trailer+ } +
+ src/Hurdle/Ar/TextDump.hs view
@@ -0,0 +1,100 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Hurdle.Ar.TextDump+-- Copyright : (c) Stephen Tetley 2009+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : +--+-- Pretty print as text...+--+--------------------------------------------------------------------------------++module Hurdle.Ar.TextDump where++import Hurdle.Base.Utils ( applyfs )+import Hurdle.Ar.Datatypes++import Data.Char+import Numeric+import Text.PrettyPrint.JoinPrint hiding ( length )++++printArchive :: ArArchive -> IO ()+printArchive = putStr . archiveText++archiveText :: ArArchive -> String+archiveText = render . ppArchive++ppArchive :: ArArchive -> Doc+ppArchive a = + text (ar_magic a)+ <%> (vcat $ map ppArchiveObject $ ar_objects a)++++ppArchiveObject :: ArchiveObject -> Doc+ppArchiveObject = ppArHeader . ar_header++ppArHeader :: ArHeader -> Doc+ppArHeader a = + tableProlog "Header" (24,6) (applyfs fields a) + where+ ppf = ppField 4 24 + fields = + [ ppf 16 "name" (text . arh_name)+ , ppf 12 "date" (text . arh_date)+ , ppf 6 "user id" (int . arh_user_id)+ , ppf 6 "group id" (int . arh_group_id)+ , ppf 8 "mode" (text . arh_mode)+ , ppf 10 "size" (int . arh_size)+ , ppf 2 "trailer" (tup2 . arh_trailer)+ ]+ tup2 (x:y:xs) = ppHex 2 (ord x) <+> ppHex 2 (ord y) <+> text xs+ tup2 xs = text xs+++++--------------------------------------------------------------------------------+-- 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 . punctuate comma+
+ src/Hurdle/Base/Utils.hs view
@@ -0,0 +1,93 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Hurdle.Base.Utils+-- Copyright : (c) Stephen Tetley 2009+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- +--+--------------------------------------------------------------------------------++module Hurdle.Base.Utils + (+ module Data.ParserCombinators.KangarooWriter+ , Parser+ , (<:>) + , applyfs+ , H+ , toList+ , logline+ , logPosition++ , stringTruncate+ ) where+++import Data.ParserCombinators.KangarooWriter++import Control.Applicative+import Data.Monoid++type Parser a = Kangaroo (H Char) a +++infixr 5 <:>++-- | applicative cons+(<:>) :: Applicative f => f a -> f [a] -> f [a]+(<:>) p1 p2 = (:) <$> p1 <*> p2++++-- applyfs is 'sequence' from Control.Monad but I don't want to drag in+-- Control.Monad.Instances+--+applyfs :: [(a -> b)] -> a -> [b]+applyfs [] _ = [] +applyfs (f:fs) a = f a : applyfs fs 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 = region >>= \(_,p,e) ->+ logline $ s ++ ", current position " ++ show p + ++ " & region-end " ++ show e+++--------------------------------------------------------------------------------++stringTruncate :: String -> String+stringTruncate = takeWhile (/= '\NUL')
+ src/Hurdle/Coff/Datatypes.hs view
@@ -0,0 +1,186 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Hurdle.Coff.Datatypes+-- Copyright : (c) Stephen Tetley 2009+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- +--+--------------------------------------------------------------------------------++module Hurdle.Coff.Datatypes where++import Data.Map ( Map )+import Data.Word++data Image = Image + { image_dos_header :: DOSHeader+ , image_signature :: (Char,Char,Char,Char)+ , image_coff_header :: COFFHeader+ , image_opt_header :: ImageOptionalHeader+ , image_section_headers :: SectionHeaders+ , image_export_data :: Maybe ExportData+ }+ deriving Show++image_DOS_HEADER_size :: Int+image_DOS_HEADER_size = 64++data DOSHeader = DOSHeader + { dh_magic_number :: Word16+ , dh_bytes_on_last_page :: Word16+ , dh_pages_in_file :: Word16+ , dh_relocations :: Word16+ , dh_header_paras_size :: Word16+ , dh_min_extra_paras :: Word16+ , dh_max_extra_paras :: Word16+ , dh_initial_relative_ss :: Word16+ , dh_initial_sp :: Word16+ , dh_header_checksum :: Word16+ , dh_initial_ip :: Word16 + , dh_initial_relative_cs :: Word16+ , dh_reltable_file_addr :: Word16+ , dh_overlay_number :: Word16+ , dh_reserved_words :: (Word16,Word16,Word16,Word16)+ , dh_oem_identifier :: Word16+ , dh_oem_info :: Word16+ , dh_reserved_words_two :: [Word16] -- length 10+ , dh_new_exe_addr :: Word32+ } + deriving Show++++image_COFF_HEADER_size :: Int+image_COFF_HEADER_size = 20++data COFFHeader = COFFHeader + { ch_machine :: Word16+ , ch_num_sections :: Word16+ , ch_timedate_stamp :: Word32+ , ch_sym_table_ptr :: Word32+ , ch_num_symbols :: Word32+ , ch_opt_header_size :: Word16+ , ch_characteristics :: Word16+ }+ deriving Show+++data ImageOptionalHeader = ImageOptionalHeader+ { ioh_header_std_fields :: OptionalStandardHeader+ , ioh_nt_specific_fields :: OptionalWindowsHeader+ , ioh_data_directory :: [HeaderDataDirectory]+ }+ deriving Show+ ++data OptionalStandardHeader = OptionalStandardHeader+ { osh_magic :: Word16+ , osh_major_linker_version :: Word8+ , osh_minor_linker_version :: Word8+ , osh_size_of_code :: Word32+ , osh_size_of_inited_data :: Word32+ , osh_size_of_uninited_data :: Word32+ , osh_entry_point_addr :: Word32+ , osh_base_of_code :: Word32+ , osh_base_of_data :: Word32+ }+ deriving Show++data OptionalWindowsHeader = OptionalWindowsHeader+ { owh_image_base :: Word32+ , owh_section_alignment :: Word32+ , owh_file_alignment :: Word32+ , owh_major_os_version :: Word16+ , owh_minor_os_version :: Word16+ , owh_major_image_version :: Word16+ , owh_minor_image_version :: Word16+ , owh_major_subsys_version :: Word16+ , owh_minor_subsys_version :: Word16+ , owh_win32_version :: Word32+ , owh_size_of_image :: Word32+ , owh_size_of_headers :: Word32+ , owh_checksum :: Word32+ , owh_subsystem :: Word16+ , owh_dll_characteristics :: Word16+ , owh_size_stack_reserve :: Word32+ , owh_size_stack_commit :: Word32+ , owh_size_heap_reserve :: Word32+ , owh_size_heap_commit :: Word32+ , owh_loader_flags :: Word32+ , owh_rva_num_and_sizes :: Word32+ } + deriving Show++image_DATA_DIRECTORY_size :: Int+image_DATA_DIRECTORY_size = 4++data HeaderDataDirectory = HeaderDataDirectory+ { hdd_virtual_addr :: Word32+ , hdd_size :: Word32+ }+ deriving Show+++type SectionHeaders = Map String SectionHeader++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 :: ExportAddressTable+ , 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++newtype ExportAddressTable = ExportAddressTable + { getExportAddressTable :: [ExportAddress] }+ deriving Show+++data ExportAddress = EA_Export_RVA Word32+ | EA_Forwarder_RVA Word32 + deriving Show+++++
+ src/Hurdle/Coff/DefOutput.hs view
@@ -0,0 +1,42 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Hurdle.Coff.DefOutput+-- Copyright : (c) Stephen Tetley 2009+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : +--+-- Print in .def format+--+--------------------------------------------------------------------------------++module Hurdle.Coff.DefOutput where++import Hurdle.Coff.Datatypes++import Text.PrettyPrint.JoinPrint++printDef :: Image -> IO ()+printDef = mapM_ (putStrLn . render) . defs+++defs :: Image -> [Doc]+defs = maybe failureMessage exportData . image_export_data+++exportData :: ExportData -> [Doc]+exportData a = + text "LIBRARY" <+> text (ed_dll_name a) : text "EXPORTS"+ : (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/Coff/Parser.hs view
@@ -0,0 +1,389 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Hurdle.Coff.Parser+-- Copyright : (c) Stephen Tetley 2009-2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- Read a DLL or an .o in COFF format...+--+--------------------------------------------------------------------------------++module Hurdle.Coff.Parser where++import Hurdle.Coff.Datatypes+import Hurdle.Base.Utils++import Control.Applicative+import Control.Monad+import qualified Data.Map as Map+import Data.Word+++readDLL :: FilePath -> IO Image+readDLL filename = do+ (ans,w) <- runKangaroo dllFile filename+ case ans of + Left err -> (putStrLn $ toList w) >> error err+ Right mf -> return mf+++readCOFF :: FilePath -> IO COFFHeader+readCOFF filename = do+ (ans,w) <- runKangaroo coffHeader filename+ case ans of + Left err -> (putStrLn $ toList w) >> error err+ Right mf -> return mf+++--------------------------------------------------------------------------------+-- + + +dllFile :: Parser Image+dllFile = do+ dos_header <- dosHeader+ advanceToNewExeHeader (dh_new_exe_addr dos_header)+ signature <- pecoffSignature+ coff_header <- coffHeader+ optional_header <- imageOptionalHeader+ section_headers <- sectionHeaders + (fromIntegral $ ch_num_sections coff_header)+ logline "just before export data"+ mb_export_data <- optExportData section_headers+ return $ Image { image_dos_header = dos_header+ , image_signature = signature+ , image_coff_header = coff_header+ , image_opt_header = optional_header+ , image_section_headers = section_headers+ , image_export_data = mb_export_data+ }++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 $ advance "export data" Alfermata raw_data (exportData a) ++++advanceToNewExeHeader :: Word32 -> Parser ()+advanceToNewExeHeader n = do + _anon <- getBytes (n - dosHSize)+ return () + where+ dosHSize = 0x0040++dosHeader :: Parser DOSHeader+dosHeader = do + magic <- magicNumber+ bytes_on_last_page <- word16le+ pages_in_file <- word16le+ relocations <- word16le+ header_paras_size <- word16le+ min_extra_paras <- word16le+ max_extra_paras <- word16le+ initial_ss_value <- word16le+ initial_sp_value <- word16le+ checksum <- word16le+ initial_ip_value <- word16le+ initial_cs_value <- word16le+ reloc_table_addr <- word16le+ overlay_number <- word16le+ reserved_1 <- reserved1+ oem_id <- word16le+ oem_info <- word16le+ reserved_2 <- reserved2+ new_exe_addr <- word32le+ return $ DOSHeader + { dh_magic_number = magic+ , dh_bytes_on_last_page = bytes_on_last_page+ , dh_pages_in_file = pages_in_file+ , dh_relocations = relocations+ , dh_header_paras_size = header_paras_size+ , dh_min_extra_paras = min_extra_paras+ , dh_max_extra_paras = max_extra_paras+ , dh_initial_relative_ss = initial_ss_value+ , dh_initial_sp = initial_sp_value+ , dh_header_checksum = checksum+ , dh_initial_ip = initial_ip_value+ , dh_initial_relative_cs = initial_cs_value+ , dh_reltable_file_addr = reloc_table_addr+ , dh_overlay_number = overlay_number+ , dh_reserved_words = reserved_1+ , dh_oem_identifier = oem_id+ , dh_oem_info = oem_info+ , dh_reserved_words_two = reserved_2+ , dh_new_exe_addr = new_exe_addr+ }+ where+ -- | Magic number 0x5a4d++ magicNumber :: Parser Word16+ magicNumber = word16le+ + reserved1 :: Parser (Word16,Word16,Word16,Word16)+ reserved1 = liftM4 (,,,) word16le word16le word16le word16le++ reserved2 :: Parser [Word16]+ reserved2 = count 10 word16le+++pecoffSignature :: Parser (Char,Char,Char,Char) +pecoffSignature = liftM4 (,,,) char char char char++++coffHeader :: Parser COFFHeader+coffHeader = do+ machine <- word16le+ num_sections <- word16le+ timestamp <- word32le+ symtab_ptr <- word32le+ num_symbols <- word32le+ opt_header_size <- word16le+ characteristics <- word16le+ return $ COFFHeader + { ch_machine = machine+ , ch_num_sections = num_sections+ , ch_timedate_stamp = timestamp+ , ch_sym_table_ptr = symtab_ptr+ , ch_num_symbols = num_symbols+ , ch_opt_header_size = opt_header_size+ , ch_characteristics = characteristics+ } ++imageOptionalHeader :: Parser ImageOptionalHeader+imageOptionalHeader = do + standard_fields <- optionalStandardHeader+ nt_specific_fields <- optionalWindowsHeader+ data_directory <- count 16 headerDataDirectory+ return $ ImageOptionalHeader+ { ioh_header_std_fields = standard_fields+ , ioh_nt_specific_fields = nt_specific_fields+ , ioh_data_directory = data_directory+ } ++optionalStandardHeader :: Parser OptionalStandardHeader+optionalStandardHeader = do+ magic <- word16le+ major_linker_number <- word8+ minor_linker_number <- word8+ code_size <- word32le+ initialized_dsize <- word32le+ uninitialized_dsize <- word32le+ entry_point_addr <- word32le+ base_of_code <- word32le+ base_of_data <- word32le+ return $ OptionalStandardHeader+ { osh_magic = magic+ , osh_major_linker_version = major_linker_number+ , osh_minor_linker_version = minor_linker_number+ , osh_size_of_code = code_size+ , osh_size_of_inited_data = initialized_dsize+ , osh_size_of_uninited_data = uninitialized_dsize+ , osh_entry_point_addr = entry_point_addr+ , osh_base_of_code = base_of_code+ , osh_base_of_data = base_of_data+ }++optionalWindowsHeader :: Parser OptionalWindowsHeader+optionalWindowsHeader = do+ image_base <- word32le+ section_alignment <- word32le+ file_alignment <- word32le+ major_os_version <- word16le+ minor_os_version <- word16le+ major_image_version <- word16le+ minor_image_version <- word16le+ major_subsys <- word16le+ minor_subsys <- word16le+ win32_version <- word32le+ image_size <- word32le+ headers_size <- word32le+ checksum <- word32le+ subsystem <- word16le+ characteristics <- word16le+ reserve_stack_size <- word32le+ commit_stack_size <- word32le+ reserve_heap_size <- word32le+ commit_heap_size <- word32le+ loader_flags <- word32le+ rva_num_and_sizes <- word32le+ return $ OptionalWindowsHeader+ { owh_image_base = image_base+ , owh_section_alignment = section_alignment+ , owh_file_alignment = file_alignment+ , owh_major_os_version = major_os_version+ , owh_minor_os_version = minor_os_version+ , owh_major_image_version = major_image_version+ , owh_minor_image_version = minor_image_version+ , owh_major_subsys_version = major_subsys+ , owh_minor_subsys_version = minor_subsys+ , owh_win32_version = win32_version+ , owh_size_of_image = image_size+ , owh_size_of_headers = headers_size+ , owh_checksum = checksum+ , owh_subsystem = subsystem+ , owh_dll_characteristics = characteristics+ , owh_size_stack_reserve = reserve_stack_size+ , owh_size_stack_commit = commit_stack_size+ , owh_size_heap_reserve = reserve_heap_size+ , owh_size_heap_commit = commit_heap_size+ , owh_loader_flags = loader_flags+ , owh_rva_num_and_sizes = rva_num_and_sizes+ } +++headerDataDirectory :: Parser HeaderDataDirectory+headerDataDirectory = do+ virtual_addr <- word32le+ size <- word32le+ return $ HeaderDataDirectory+ { hdd_virtual_addr = virtual_addr+ , hdd_size = size+ }++-- 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 = do+ name <- liftM stringTruncate (count 8 char) + -- this should be a combinator++ virtual_size <- word32le+ virtual_addr <- word32le+ raw_data_size <- word32le+ raw_data_ptr <- word32le+ relocations_ptr <- word32le+ line_nums_ptr <- word32le+ relocations_count <- word16le+ line_nums_count <- word16le+ characteristics <- word32le+ return $ SectionHeader+ { sh_name = name+ , sh_virtual_size = virtual_size+ , sh_virtual_addr = virtual_addr+ , sh_size_raw_data = raw_data_size+ , sh_ptr_raw_data = raw_data_ptr+ , sh_ptr_relocations = relocations_ptr+ , sh_ptr_linenums = line_nums_ptr+ , sh_num_relocations = relocations_count+ , sh_num_linenums = line_nums_count+ , sh_characteristics = characteristics+ }+++forwardParse :: RegionName + -> (ExportDirectoryTable -> Word32)+ -> ExportDirectoryTable+ -> SectionHeader+ -> Parser a+ -> Parser a+forwardParse name f edt section p = advance name Dalpunto pos p+ where+ pos = fromIntegral $ rvaToOffset (f edt) section+ ++-- At some point... I'll tidy this up.++exportData :: SectionHeader -> Parser ExportData+exportData section = do+ logPosition "starting exportData..."+ edt <- exportDirectoryTable+ logline $ show edt+ logPosition "export addr table"+ let eac = fromIntegral $ edt_num_addr_table_entries edt+ logline $ "num entries in export address table " ++ show eac++ ats <- forwardParse "address table" + edt_export_addr_table_rva edt section+ (exportAddressTable eac)++ logPosition "ptr_table"+ let enc = fromIntegral $ edt_num_name_ptrs edt+ nptrs <- forwardParse "name pointers"+ edt_name_ptr_table_rva edt section+ (count enc word32le)++ ords <- forwardParse "ordinals"+ edt_ordinal_table_rva edt section+ (count enc word16le)++ names <- exportNames section nptrs+ + dllname <- forwardParse "dll name"+ edt_name_rva edt section 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 = do+ export_flags <- word32le+ timestamp <- word32le+ major_version <- word16le+ minor_version <- word16le+ name_rva <- word32le+ ordinal_base <- word32le+ addr_table_count <- word32le+ name_ptrs_count <- word32le+ export_table_rva <- word32le+ name_table_rva <- word32le+ ordinal_table_rva <- word32le+ return $ ExportDirectoryTable + { edt_export_flags = export_flags+ , edt_timedate_stamp = timestamp+ , edt_major_version = major_version+ , edt_minor_version = minor_version+ , edt_name_rva = name_rva+ , edt_ordinal_base = ordinal_base+ , edt_num_addr_table_entries = addr_table_count+ , edt_num_name_ptrs = name_ptrs_count+ , edt_export_addr_table_rva = export_table_rva+ , edt_name_ptr_table_rva = name_table_rva+ , edt_ordinal_table_rva = ordinal_table_rva+ }+++exportAddressTable :: Int -> Parser ExportAddressTable+exportAddressTable n = liftM ExportAddressTable $ count n exportAddress ++-- WRONG (for now) +exportAddress :: Parser ExportAddress+exportAddress = liftM 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+ `substError` "export name..."+++jumpto :: Int -> Parser a -> Parser a+jumpto i p = + logline ("jumpto " ++ show i) >> advance "export name" Dalpunto i p++ +rvaToOffset :: Word32 -> SectionHeader -> Word32+rvaToOffset rva section = + rva - (sh_virtual_addr section - sh_ptr_raw_data section)
+ src/Hurdle/Coff/TextDump.hs view
@@ -0,0 +1,297 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Hurdle.Coff.TextDump+-- Copyright : (c) Stephen Tetley 2009+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : +--+-- Pretty print as text... This is horrible and needs rethinking...+--+--------------------------------------------------------------------------------++module Hurdle.Coff.TextDump where++import Hurdle.Base.Utils ( applyfs )+import Hurdle.Coff.Datatypes++import qualified Data.Map as Map+import Data.Word+import Numeric+import Text.PrettyPrint.JoinPrint hiding ( length )++++printImage :: Image -> IO ()+printImage = putStr . imageText++imageText :: Image -> String+imageText = render . ppImage++printCOFF :: COFFHeader -> IO ()+printCOFF = putStr . coff++coff :: COFFHeader -> String+coff = render . ppCOFFHeader++ppImage :: Image -> Doc+ppImage a = + ppDOSHeader (image_dos_header a)+ <%> columnSep+ <%> ppSignature (image_signature a)+ <%> ppCOFFHeader (image_coff_header a)+ <%> ppImageOptionalHeader (image_opt_header a)+ <%> (vcat $ map ppSectionHeader $ Map.elems $ image_section_headers a)+ <%> maybe empty ppExportData (image_export_data a)+++ppDOSHeader :: DOSHeader -> Doc+ppDOSHeader a = + tableProlog "IMAGE_DOS_HEADER" (24,6) (applyfs fields a) + where+ ppf = ppField 4 24 + fields = + [ ppf 2 "magic" (ppHex 4 . dh_magic_number)+ , ppf 2 "bytes last page" (ppHex 4 . dh_bytes_on_last_page)+ , ppf 2 "pages in file" (ppHex 4 . dh_pages_in_file)+ , ppf 2 "relocations" (ppHex 4 . dh_relocations)+ , ppf 2 "header para size" (ppHex 4 . dh_header_paras_size)+ , ppf 2 "min extra paragraphs" (ppHex 4 . dh_min_extra_paras)+ , ppf 2 "max extra paragraphs" (ppHex 4 . dh_max_extra_paras)+ , ppf 2 "initial SS value" (ppHex 4 . dh_initial_relative_ss)+ , ppf 2 "initial SP value" (ppHex 4 . dh_initial_sp)+ , ppf 2 "checksum" (ppHex 4 . dh_header_checksum)++ , ppf 2 "initial IP value" (ppHex 4 . dh_initial_ip)+ , ppf 2 "initial CS value" (ppHex 4 . dh_initial_relative_cs)+ , ppf 2 "relocation table addr" (ppHex 4 . dh_reltable_file_addr)+ , ppf 2 "overlay number" (ppHex 4 . dh_overlay_number)+ , ppf 8 "reserved 1" (tup4 . dh_reserved_words)+ , ppf 2 "oem identifier" (ppHex 4 . dh_oem_identifier)+ , ppf 2 "oem info" (ppHex 4 . dh_oem_info)+ , ppf 20 "reserved 2" (text . show . dh_reserved_words_two)+ , ppf 4 "new exe header addr" (ppHex 8 . dh_new_exe_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])++ppCOFFHeader :: COFFHeader -> Doc+ppCOFFHeader a = + tableProlog "COFF HEADER" (24,6) (applyfs fields a) + where+ ppf = ppField 4 24 + fields = + [ ppf 2 "machine" (ppHex 4 . ch_machine)+ , ppf 2 "num sections" (ppHex 4 . ch_num_sections)+ , ppf 4 "timedatestamp" (ppHex 8 . ch_timedate_stamp)+ , ppf 4 "ptr to sym table" (ppHex 8 . ch_sym_table_ptr)+ , ppf 4 "num symbols" (ppHex 8 . ch_num_symbols)+ , ppf 2 "size optional header" (ppHex 4 . ch_opt_header_size)+ , ppf 2 "characteristics" (ppHex 4 . ch_characteristics)+ ]+++ppImageOptionalHeader :: ImageOptionalHeader -> Doc+ppImageOptionalHeader a = + ppOptionalStandardHeader (ioh_header_std_fields a)+ <%> ppOptionalWindowsHeader (ioh_nt_specific_fields a)+ <%> (vcat $ zipWith ppHeaderDataDirectory 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"+ ]++ppOptionalStandardHeader :: OptionalStandardHeader -> Doc+ppOptionalStandardHeader a =+ tableProlog "IMAGE OPTIONAL HEADER STANDARD" (24,6) (applyfs fields a) + where+ ppf = ppField 4 24+ fields = + [ ppf 2 "magic" (ppHex 4 . osh_magic)+ , ppf 1 "major linker ver." (ppHex 2 . osh_major_linker_version)+ , ppf 1 "minor linker ver." (ppHex 2 . osh_minor_linker_version)+ , ppf 4 "size of code" (ppHex 8 . osh_size_of_code)+ , ppf 4 "size of init. data" (ppHex 8 . osh_size_of_inited_data)+ , ppf 4 "size of uninit. data" (ppHex 8 . osh_size_of_uninited_data)+ , ppf 4 "entry ptr addr" (ppHex 8 . osh_entry_point_addr)+ , ppf 4 "base of code" (ppHex 8 . osh_base_of_code)+ , ppf 4 "base of data" (ppHex 8 . osh_base_of_data)+ ]+++ppOptionalWindowsHeader :: OptionalWindowsHeader -> Doc+ppOptionalWindowsHeader a =+ tableProlog "IMAGE OPTIONAL HEADER NT SPECIFIC" (24,6) (applyfs fields a)+ where+ ppf = ppField 4 24+ fields = + [ ppf 4 "image base" (ppHex 8 . owh_image_base)+ , ppf 4 "section alignment" (ppHex 8 . owh_section_alignment)+ , ppf 4 "file alignment" (ppHex 8 . owh_file_alignment)+ , ppf 2 "major os version" (ppHex 4 . owh_major_os_version)+ , ppf 2 "minor os version" (ppHex 4 . owh_minor_os_version)+ , ppf 2 "major image version" (ppHex 4 . owh_major_image_version)+ , ppf 2 "minor image version" (ppHex 4 . owh_minor_image_version)+ , ppf 2 "major subsys version" (ppHex 4 . owh_major_subsys_version)+ , ppf 2 "minor subsys version" (ppHex 4 . owh_minor_subsys_version)+ , ppf 4 "win32 version" (ppHex 8 . owh_win32_version)+ , ppf 4 "size of image" (ppHex 8 . owh_size_of_image)+ , ppf 4 "size of headers" (ppHex 8 . owh_size_of_headers)+ , ppf 4 "checksum" (ppHex 8 . owh_checksum)+ , ppf 2 "subsystem" (ppHex 4 . owh_subsystem)+ , ppf 2 "dll characteristics" (ppHex 4 . owh_dll_characteristics)+ , ppf 4 "size of stack reserve" (ppHex 8 . owh_size_stack_reserve)+ , ppf 4 "size of stack commit" (ppHex 8 . owh_size_stack_commit)+ , ppf 4 "size of heap reserve" (ppHex 8 . owh_size_heap_reserve)+ , ppf 4 "size of heap commit" (ppHex 8 . owh_size_heap_commit)+ , ppf 4 "loader flags" (ppHex 8 . owh_loader_flags)+ , ppf 4 "rva num and sizes" (ppHex 8 . owh_rva_num_and_sizes)+ ]++ppHeaderDataDirectory :: String -> HeaderDataDirectory -> Doc+ppHeaderDataDirectory s a =+ tableProlog s (24,6) (applyfs fields a) + where+ ppf = ppField 4 24+ fields = + [ ppf 4 "virtual address" (ppHex 8 . hdd_virtual_addr)+ , ppf 4 "size" (ppHex 8 . hdd_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 :: ExportAddressTable -> Doc+ppExportAddressTable 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+ 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 . punctuate comma+
− src/Hurdle/Datatypes.hs
@@ -1,196 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Hurdle.Datatypes--- Copyright : (c) Stephen Tetley 2009--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- Stability : highly unstable--- Portability : to be determined.------ --------------------------------------------------------------------------------------module Hurdle.Datatypes where--import Data.Map ( Map )-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 :: SectionHeaders- , image_export_data :: Maybe 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---type SectionHeaders = Map String SectionHeader--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 :: ExportAddressTable- , 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--newtype ExportAddressTable = ExportAddressTable - { getExportAddressTable :: [ExportAddress] }- deriving Show---data ExportAddress = EA_Export_RVA Word32- | EA_Forwarder_RVA Word32 - deriving Show-----
− src/Hurdle/DefOutput.hs
@@ -1,45 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Hurdle.DefOutput--- Copyright : (c) Stephen Tetley 2009--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- 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 = maybe failureMessage exportData . image_export_data---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/Parser.hs
@@ -1,286 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Hurdle.Parser--- Copyright : (c) Stephen Tetley 2009--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- Stability : highly unstable--- Portability : to be determined.------ Read a DLL...--------------------------------------------------------------------------------------module Hurdle.Parser where--import Hurdle.Datatypes-import Hurdle.Utils--import Control.Applicative-import Control.Monad-import qualified Data.Map as Map-import Data.Word---readDLL :: FilePath -> IO Image-readDLL filename = do- (ans,w) <- runKangaroo dllFile filename- case ans of - 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-------------------------------------------------------------------------------------- - - -dllFile :: Parser Image-dllFile = do- dosH <- imageDOSHeader- toNewExeHeader (idh_new_exe_header_addr dosH)- sig <- signature- coffH <- imageCOFFHeader- optH <- imageOptionalHeader- 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 = opt_expos- }--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 - _anon <- getBytes (n - dosHSize)- return () - where- dosHSize = 0x0040--imageDOSHeader :: Parser ImageDOSHeader-imageDOSHeader = ImageDOSHeader <$> - magic - <*> word16le- <*> word16le- <*> word16le- <*> word16le- <*> word16le- <*> word16le- <*> word16le- <*> word16le- <*> word16le- <*> word16le- <*> word16le- <*> word16le- <*> word16le- <*> reserved1- <*> word16le- <*> word16le- <*> reserved2- <*> word32le- where- -- | Magic number 0x5a4d-- magic :: Parser Word16- magic = word16le- - reserved1 :: Parser (Word16,Word16,Word16,Word16)- reserved1 = (,,,) <$> word16le <*> word16le - <*> word16le <*> word16le-- reserved2 :: Parser [Word16]- reserved2 = count 10 word16le---signature :: Parser (Char,Char,Char,Char) -signature = (,,,) <$> char <*> char - <*> char <*> char--imageCOFFHeader :: Parser ImageCOFFHeader-imageCOFFHeader = ImageCOFFHeader <$> - word16le- <*> word16le- <*> word32le- <*> word32le- <*> word32le- <*> word16le- <*> word16le- --imageOptionalHeader :: Parser ImageOptionalHeader-imageOptionalHeader = ImageOptionalHeader <$> - imageOptionalStandard- <*> imageOptionalNTSpecific- <*> count 16 imageDataDirectory- --imageOptionalStandard :: Parser ImageOptionalStandard-imageOptionalStandard = ImageOptionalStandard <$>- word16le- <*> word8- <*> word8- <*> word32le- <*> word32le- <*> word32le- <*> word32le- <*> word32le- <*> word32le--imageOptionalNTSpecific :: Parser ImageOptionalNTSpecific-imageOptionalNTSpecific = ImageOptionalNTSpecific <$>- 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 <$>- 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 <$>- 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- logPosition "starting exportData..."- edt <- exportDirectoryTable- logline $ show edt-- logPosition "export addr table"- let eac = fromIntegral $ edt_num_addr_table_entries edt- logline $ "num entries in export address table " ++ show eac-- 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- - dllname <- forwardParse edt_name_rva edt section 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 <$>- 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 <$> word32le---exportNames :: SectionHeader -> [Word32] -> Parser [String]-exportNames _ [] = return []-exportNames section (x:xs) = mf <:> exportNames section xs- where- 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
@@ -1,296 +0,0 @@-{-# OPTIONS -Wall #-}------------------------------------------------------------------------------------- |--- Module : Hurdle.TextDump--- Copyright : (c) Stephen Tetley 2009--- License : BSD3------ Maintainer : Stephen Tetley <stephen.tetley@gmail.com>--- Stability : highly unstable--- Portability : ------ Pretty print as text...--------------------------------------------------------------------------------------module Hurdle.TextDump where--import Hurdle.Datatypes--import qualified Data.Map as Map-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 $ Map.elems $ image_section_headers a)- $+$ maybe empty 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 :: ExportAddressTable -> Doc-ppExportAddressTable 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- 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-
− src/Hurdle/Utils.hs
@@ -1,72 +0,0 @@-{-# 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')