{-# 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)