packages feed

hurdle (empty) → 0.1.0

raw patch · 9 files changed

+1146/−0 lines, 9 filesdep +arraydep +basedep +prettysetup-changed

Dependencies added: array, base, pretty

Files

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