diff --git a/hurdle.cabal b/hurdle.cabal --- a/hurdle.cabal +++ b/hurdle.cabal @@ -1,5 +1,5 @@ name: hurdle -version: 0.2.0 +version: 0.3.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley @@ -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 + diff --git a/src/Hurdle.hs b/src/Hurdle.hs --- a/src/Hurdle.hs +++ b/src/Hurdle.hs @@ -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 diff --git a/src/Hurdle/Ar/Datatypes.hs b/src/Hurdle/Ar/Datatypes.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/Ar/Datatypes.hs @@ -0,0 +1,54 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.Ar.Datatypes +-- Copyright : (c) Stephen Tetley 2009, 2010 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- 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 + + + + + + diff --git a/src/Hurdle/Ar/Parser.hs b/src/Hurdle/Ar/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/Ar/Parser.hs @@ -0,0 +1,91 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.Ar.Parser +-- Copyright : (c) Stephen Tetley 2009, 2010 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- 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 + } + diff --git a/src/Hurdle/Ar/TextDump.hs b/src/Hurdle/Ar/TextDump.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/Ar/TextDump.hs @@ -0,0 +1,100 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.Ar.TextDump +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- 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 + diff --git a/src/Hurdle/Base/Utils.hs b/src/Hurdle/Base/Utils.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/Base/Utils.hs @@ -0,0 +1,93 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.Base.Utils +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- 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') diff --git a/src/Hurdle/Coff/Datatypes.hs b/src/Hurdle/Coff/Datatypes.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/Coff/Datatypes.hs @@ -0,0 +1,186 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.Coff.Datatypes +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- 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 + + + + + diff --git a/src/Hurdle/Coff/DefOutput.hs b/src/Hurdle/Coff/DefOutput.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/Coff/DefOutput.hs @@ -0,0 +1,42 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.Coff.DefOutput +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- 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... ---" + ] + diff --git a/src/Hurdle/Coff/Parser.hs b/src/Hurdle/Coff/Parser.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/Coff/Parser.hs @@ -0,0 +1,389 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.Coff.Parser +-- Copyright : (c) Stephen Tetley 2009-2010 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- 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) diff --git a/src/Hurdle/Coff/TextDump.hs b/src/Hurdle/Coff/TextDump.hs new file mode 100644 --- /dev/null +++ b/src/Hurdle/Coff/TextDump.hs @@ -0,0 +1,297 @@ +{-# OPTIONS -Wall #-} + +-------------------------------------------------------------------------------- +-- | +-- Module : Hurdle.Coff.TextDump +-- Copyright : (c) Stephen Tetley 2009 +-- License : BSD3 +-- +-- Maintainer : Stephen Tetley +-- 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 + diff --git a/src/Hurdle/Datatypes.hs b/src/Hurdle/Datatypes.hs deleted file mode 100644 --- a/src/Hurdle/Datatypes.hs +++ /dev/null @@ -1,196 +0,0 @@ -{-# 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.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 - - - - - diff --git a/src/Hurdle/DefOutput.hs b/src/Hurdle/DefOutput.hs deleted file mode 100644 --- a/src/Hurdle/DefOutput.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# 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 = 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... ---" - diff --git a/src/Hurdle/Parser.hs b/src/Hurdle/Parser.hs deleted file mode 100644 --- a/src/Hurdle/Parser.hs +++ /dev/null @@ -1,286 +0,0 @@ -{-# 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.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) diff --git a/src/Hurdle/TextDump.hs b/src/Hurdle/TextDump.hs deleted file mode 100644 --- a/src/Hurdle/TextDump.hs +++ /dev/null @@ -1,296 +0,0 @@ -{-# 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 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 - diff --git a/src/Hurdle/Utils.hs b/src/Hurdle/Utils.hs deleted file mode 100644 --- a/src/Hurdle/Utils.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# OPTIONS -Wall #-} - --------------------------------------------------------------------------------- --- | --- Module : Hurdle.Utils --- Copyright : (c) Stephen Tetley 2009 --- License : BSD3 --- --- Maintainer : Stephen Tetley --- 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')