hurdle 0.3.0 → 0.4.0
raw patch · 7 files changed
+327/−241 lines, 7 filesdep +bytestringdep ~kangaroo
Dependencies added: bytestring
Dependency ranges changed: kangaroo
Files
- hurdle.cabal +8/−2
- src/Hurdle/Ar/Datatypes.hs +1/−3
- src/Hurdle/Ar/Parser.hs +5/−4
- src/Hurdle/Ar/TextDump.hs +43/−46
- src/Hurdle/Base/Table.hs +98/−0
- src/Hurdle/Coff/Parser.hs +2/−2
- src/Hurdle/Coff/TextDump.hs +170/−184
hurdle.cabal view
@@ -1,5 +1,5 @@ name: hurdle-version: 0.3.0+version: 0.4.0 license: BSD3 license-file: LICENSE copyright: Stephen Tetley <stephen.tetley@gmail.com>@@ -26,6 +26,10 @@ . Change-log .+ 0.3.0 to 0.4.0 + .+ * Changed to use kangaroo-0.4.0+ . 0.2.0 to 0.3.0 . * Changes to use kangaroo-0.2.0@@ -45,13 +49,15 @@ Build-Depends: base < 5, array >= 0.2.0.0 && < 0.4, containers, - kangaroo >= 0.2.0 && < 0.3 + kangaroo >= 0.4.0 && < 0.5,+ bytestring Main-Is: Hurdle.hs Hs-Source-Dirs: src Other-Modules: Hurdle.Ar.Datatypes, Hurdle.Ar.Parser, Hurdle.Ar.TextDump,+ Hurdle.Base.Table, Hurdle.Base.Utils, Hurdle.Coff.Datatypes, Hurdle.Coff.DefOutput,
src/Hurdle/Ar/Datatypes.hs view
@@ -16,8 +16,6 @@ module Hurdle.Ar.Datatypes where -import qualified Data.ByteString as BSW8-import Data.Word data ArArchive = ArArchive { ar_magic :: String@@ -28,7 +26,7 @@ data ArchiveObject = ArchiveObject { ar_header :: ArHeader- , ar_body :: [Word8] -- needs thought... shouldn't be a list+ , ar_body :: (Int,Int) } data ArHeader = ArHeader
src/Hurdle/Ar/Parser.hs view
@@ -56,16 +56,17 @@ 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 + body <- count sz word8+ end_pos <- position+ when (end_pos `mod` 2 /= 0) (anyChar >> return ()) -- should be a newline return $ ArchiveObject { ar_header = header- , ar_body = body+ , ar_body = (pos,sz) } paddedNumber :: (Read a, Integral a) => Int -> Parser a-paddedNumber i = liftM fn $ count i char+paddedNumber i = liftM fn $ count i anyChar where fn = read . takeWhile isDigit
src/Hurdle/Ar/TextDump.hs view
@@ -16,11 +16,10 @@ module Hurdle.Ar.TextDump where -import Hurdle.Base.Utils ( applyfs )+import Hurdle.Base.Table import Hurdle.Ar.Datatypes import Data.Char-import Numeric import Text.PrettyPrint.JoinPrint hiding ( length ) @@ -29,33 +28,31 @@ printArchive = putStr . archiveText archiveText :: ArArchive -> String-archiveText = render . ppArchive--ppArchive :: ArArchive -> Doc-ppArchive a = - text (ar_magic a)- <%> (vcat $ map ppArchiveObject $ ar_objects a)+archiveText = show . ppArchive +ppArchive :: ArArchive -> VDoc+ppArchive a = vconcat $+ [ vdoc $ text $ ar_magic a+ , vconcat $ map ppArchiveObject $ ar_objects a+ ] -ppArchiveObject :: ArchiveObject -> Doc+ppArchiveObject :: ArchiveObject -> VDoc ppArchiveObject = ppArHeader . ar_header -ppArHeader :: ArHeader -> Doc-ppArHeader a = - tableProlog "Header" (24,6) (applyfs fields a) +ppArHeader :: ArHeader -> VDoc+ppArHeader = mkTable "Header" . vcat . sequence fields 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)+ [ recRow 16 "name" . text . arh_name+ , recRow 12 "date" . text . arh_date+ , recRow 6 "user id" . int . arh_user_id+ , recRow 6 "group id" . int . arh_group_id+ , recRow 8 "mode" . text . arh_mode+ , recRow 10 "size" . int . arh_size+ , recRow 2 "trailer" . tup2 . arh_trailer ]- tup2 (x:y:xs) = ppHex 2 (ord x) <+> ppHex 2 (ord y) <+> text xs+ tup2 (x:y:xs) = oxhex 2 (ord x) <+> oxhex 2 (ord y) <+> text xs tup2 xs = text xs @@ -64,37 +61,37 @@ -------------------------------------------------------------------------------- -- 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")+-- 4r-24r-24l +colHeadings :: VDoc +colHeadings = vdoc $ row3 (text "size") (text "field") (text "value") -columnSep :: Doc-columnSep = text $ replicate 60 '-' +row3 :: Doc -> Doc -> Doc -> Doc+row3 = row dblspace (alignRight 4 $ alignRight 24 $ alignLeft 24 $ endrow) +recRow :: Int -> String -> Doc -> Doc+recRow fsize name doc = row3 (int fsize) (text name) doc -ppField :: Int -> Int -> Int -> String -> (a -> Doc) -> a -> Doc-ppField n1 n2 sz field_name f a = text sz' <+> text field_name' <+> f a+type TableName = String++mkTable :: TableName -> VDoc -> VDoc+mkTable tname rows = title `vcons` (block1 `vappend` rows) where- sz' = pad n1 ' ' (show sz)- field_name' = pad n2 ' ' field_name+ title = text tname+ block1 = vconcat [rowSep, colHeadings, rowSep] -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+rowSep :: VDoc+rowSep = vdoc $ replicateChar 60 '-' -listDoc :: [Doc] -> Doc-listDoc = brackets . punctuate comma++-- TO ADD TO JoinPrint+list :: [Doc] -> Doc+list = brackets . punctuate comma++vdoc :: Doc -> VDoc+vdoc = vcat . return++vappend :: VDoc -> VDoc -> VDoc+vappend a b = vconcat [a,b]
+ src/Hurdle/Base/Table.hs view
@@ -0,0 +1,98 @@+{-# OPTIONS -Wall #-}++--------------------------------------------------------------------------------+-- |+-- Module : Hurdle.Base.Table+-- Copyright : (c) Stephen Tetley 2010+-- License : BSD3+--+-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>+-- Stability : highly unstable+-- Portability : to be determined.+--+-- Table formatting+--+--------------------------------------------------------------------------------++module Hurdle.Base.Table + (+ FieldWidth+ , Rowf+ , row+ , endrow+ , alignLeft+ , alignRight+ , alignCenter++ ) where+++import Text.PrettyPrint.JoinPrint -- package: kangaroo++import Prelude hiding ( length, null )++data Align = ALeft | ACenter | ARight+ deriving (Eq,Ord,Show)++type FieldWidth = Int++type FieldProp = (FieldWidth,Align)++-- Little trick to avoided prefixing with the sep+type Sep = Either Doc Doc++-- Essentially the 'typecase' printf...+-- Note an extra arg is threaded fr the separator++++newtype Rowf t = Rowf { rowfApp :: Sep -> Doc -> t }++field :: FieldProp -> Rowf t -> Rowf (Doc -> t)+field prop k = Rowf $ \rator acc d -> case rator of+ Left sep -> rowfApp k (Right sep) (format1 prop d)+ Right sep -> rowfApp k (Right sep) (acc <> sep <> (format1 prop d))+++endrow :: Rowf Doc+endrow = Rowf $ \_ acc -> acc+++row :: Doc -> Rowf t -> t+row sep p = (rowfApp p) (Left sep) empty+++alignLeft :: FieldWidth -> Rowf t -> Rowf (Doc -> t)+alignLeft w = field (w,ALeft)++alignRight :: FieldWidth -> Rowf t -> Rowf (Doc -> t)+alignRight w = field (w,ARight)++alignCenter :: FieldWidth -> Rowf t -> Rowf (Doc -> t)+alignCenter w = field (w,ACenter)++++format1 :: FieldProp -> Doc -> Doc +format1 (w,align) d = step (length d) where+ step dw | dw > w = truncateTo w align d+ | dw < w = padTo w align d+ | otherwise = d++-- Note truncate with Center alignment truncates the right side+truncateTo :: Int -> Align -> Doc -> Doc+truncateTo w ALeft d = truncr w d+truncateTo w _ d = truncl w d++-- truncateTo w ACenter d = let (a,b) = splitTwo w in truncl b $ truncr a d ++padTo :: Int -> Align -> Doc -> Doc+padTo w ALeft d = padr w ' ' d+padTo w ACenter d = let (a,b) = splitTwo w in padl b ' ' $ padr a ' ' d +padTo w ARight d = padl w ' ' d++splitTwo :: Int -> (Int,Int)+splitTwo n | even n = let h = n `div` 2 in (h,h)+ | otherwise = let h = n `div` 2 in (h+1,h)++
src/Hurdle/Coff/Parser.hs view
@@ -135,7 +135,7 @@ pecoffSignature :: Parser (Char,Char,Char,Char) -pecoffSignature = liftM4 (,,,) char char char char+pecoffSignature = liftM4 (,,,) anyChar anyChar anyChar anyChar @@ -259,7 +259,7 @@ sectionHeader :: Parser SectionHeader sectionHeader = do- name <- liftM stringTruncate (count 8 char) + name <- liftM stringTruncate (count 8 anyChar) -- this should be a combinator virtual_size <- word32le
src/Hurdle/Coff/TextDump.hs view
@@ -16,12 +16,11 @@ module Hurdle.Coff.TextDump where -import Hurdle.Base.Utils ( applyfs )+import Hurdle.Base.Table import Hurdle.Coff.Datatypes import qualified Data.Map as Map import Data.Word-import Numeric import Text.PrettyPrint.JoinPrint hiding ( length ) @@ -30,80 +29,77 @@ printImage = putStr . imageText imageText :: Image -> String-imageText = render . ppImage+imageText = show . 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)+coff = show . ppCOFFHeader +ppImage :: Image -> VDoc+ppImage a = vconcat $+ [ ppDOSHeader (image_dos_header a)+ , rowSep+ , vdoc $ ppSignature (image_signature a)+ , ppCOFFHeader (image_coff_header a)+ , ppImageOptionalHeader (image_opt_header a)+ , (vconcat $ map ppSectionHeader $ Map.elems $ image_section_headers a)+ , maybe (vdoc empty) ppExportData (image_export_data a)+ ] -ppDOSHeader :: DOSHeader -> Doc-ppDOSHeader a = - tableProlog "IMAGE_DOS_HEADER" (24,6) (applyfs fields a) +ppDOSHeader :: DOSHeader -> VDoc+ppDOSHeader = mkTable "IMAGE_DOS_HEADER" . vcat . sequence fields 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)+ [ recRow 2 "magic" . oxhex4 . dh_magic_number+ , recRow 2 "bytes last page" . oxhex4 . dh_bytes_on_last_page+ , recRow 2 "pages in file" . oxhex4 . dh_pages_in_file+ , recRow 2 "relocations" . oxhex4 . dh_relocations+ , recRow 2 "header para size" . oxhex4 . dh_header_paras_size+ , recRow 2 "min extra paragraphs" . oxhex4 . dh_min_extra_paras+ , recRow 2 "max extra paragraphs" . oxhex4 . dh_max_extra_paras+ , recRow 2 "initial SS value" . oxhex4 . dh_initial_relative_ss+ , recRow 2 "initial SP value" . oxhex4 . dh_initial_sp+ , recRow 2 "checksum" . oxhex4 . 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)- ]+ , recRow 2 "initial IP value" . oxhex4 . dh_initial_ip+ , recRow 2 "initial CS value" . oxhex4 . dh_initial_relative_cs+ , recRow 2 "relocation table addr" . oxhex4 . dh_reltable_file_addr+ , recRow 2 "overlay number" . oxhex4 . dh_overlay_number+ , recRow 8 "reserved 1" . tup4 . dh_reserved_words+ , recRow 2 "oem identifier" . oxhex4 . dh_oem_identifier+ , recRow 2 "oem info" . oxhex4 . dh_oem_info+ , recRow 20 "reserved 2" . text . show . dh_reserved_words_two+ , recRow 4 "new exe header addr" . oxhex8 . 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])+ text "Signature:" <+> (list $ map (text . show) [s,t,u,v]) -ppCOFFHeader :: COFFHeader -> Doc-ppCOFFHeader a = - tableProlog "COFF HEADER" (24,6) (applyfs fields a) +ppCOFFHeader :: COFFHeader -> VDoc+ppCOFFHeader = mkTable "COFF HEADER" . vcat . sequence fields 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)+ [ recRow 2 "machine" . oxhex4 . ch_machine+ , recRow 2 "num sections" . oxhex4 . ch_num_sections+ , recRow 4 "timedatestamp" . oxhex8 . ch_timedate_stamp+ , recRow 4 "ptr to sym table" . oxhex8 . ch_sym_table_ptr+ , recRow 4 "num symbols" . oxhex8 . ch_num_symbols+ , recRow 2 "size optional header" . oxhex4 . ch_opt_header_size+ , recRow 2 "characteristics" . oxhex4 . 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))+ppImageOptionalHeader :: ImageOptionalHeader -> VDoc+ppImageOptionalHeader a = vconcat $+ [ ppOptionalStandardHeader $ ioh_header_std_fields a+ , ppOptionalWindowsHeader $ ioh_nt_specific_fields a+ , vconcat $ zipWith ppHeaderDataDirectory names $ ioh_data_directory a+ ] where names = [ ".edata" , ".idata"@@ -123,175 +119,165 @@ , "reserved" ] -ppOptionalStandardHeader :: OptionalStandardHeader -> Doc-ppOptionalStandardHeader a =- tableProlog "IMAGE OPTIONAL HEADER STANDARD" (24,6) (applyfs fields a) +ppOptionalStandardHeader :: OptionalStandardHeader -> VDoc+ppOptionalStandardHeader = + mkTable "IMAGE OPTIONAL HEADER STANDARD" . vcat . sequence fields 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)+ [ recRow 2 "magic" . oxhex4 . osh_magic+ , recRow 1 "major linker ver." . oxhex2 . osh_major_linker_version+ , recRow 1 "minor linker ver." . oxhex2 . osh_minor_linker_version+ , recRow 4 "size of code" . oxhex8 . osh_size_of_code+ , recRow 4 "size of init. data" . oxhex8 . osh_size_of_inited_data+ , recRow 4 "size of uninit. data" . oxhex8 . osh_size_of_uninited_data+ , recRow 4 "entry ptr addr" . oxhex8 . osh_entry_point_addr+ , recRow 4 "base of code" . oxhex8 . osh_base_of_code+ , recRow 4 "base of data" . oxhex8 . osh_base_of_data ] -ppOptionalWindowsHeader :: OptionalWindowsHeader -> Doc-ppOptionalWindowsHeader a =- tableProlog "IMAGE OPTIONAL HEADER NT SPECIFIC" (24,6) (applyfs fields a)+ppOptionalWindowsHeader :: OptionalWindowsHeader -> VDoc+ppOptionalWindowsHeader =+ mkTable "IMAGE OPTIONAL HEADER NT SPECIFIC" . vcat . sequence fields 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)+ [ recRow 4 "image base" . oxhex8 . owh_image_base+ , recRow 4 "section alignment" . oxhex8 . owh_section_alignment+ , recRow 4 "file alignment" . oxhex8 . owh_file_alignment+ , recRow 2 "major os version" . oxhex4 . owh_major_os_version+ , recRow 2 "minor os version" . oxhex4 . owh_minor_os_version+ , recRow 2 "major image version" . oxhex4 . owh_major_image_version+ , recRow 2 "minor image version" . oxhex4 . owh_minor_image_version+ , recRow 2 "major subsys version" . oxhex4 . owh_major_subsys_version+ , recRow 2 "minor subsys version" . oxhex4 . owh_minor_subsys_version+ , recRow 4 "win32 version" . oxhex8 . owh_win32_version+ , recRow 4 "size of image" . oxhex8 . owh_size_of_image+ , recRow 4 "size of headers" . oxhex8 . owh_size_of_headers+ , recRow 4 "checksum" . oxhex8 . owh_checksum+ , recRow 2 "subsystem" . oxhex4 . owh_subsystem+ , recRow 2 "dll characteristics" . oxhex4 . owh_dll_characteristics+ , recRow 4 "size of stack reserve" . oxhex8 . owh_size_stack_reserve+ , recRow 4 "size of stack commit" . oxhex8 . owh_size_stack_commit+ , recRow 4 "size of heap reserve" . oxhex8 . owh_size_heap_reserve+ , recRow 4 "size of heap commit" . oxhex8 . owh_size_heap_commit+ , recRow 4 "loader flags" . oxhex8 . owh_loader_flags+ , recRow 4 "rva num and sizes" . oxhex8 . owh_rva_num_and_sizes ] -ppHeaderDataDirectory :: String -> HeaderDataDirectory -> Doc-ppHeaderDataDirectory s a =- tableProlog s (24,6) (applyfs fields a) +ppHeaderDataDirectory :: String -> HeaderDataDirectory -> VDoc+ppHeaderDataDirectory name = mkTable name . vcat . sequence fields where- ppf = ppField 4 24 fields = - [ ppf 4 "virtual address" (ppHex 8 . hdd_virtual_addr)- , ppf 4 "size" (ppHex 8 . hdd_size)- ]+ [ recRow 4 "virtual address" . oxhex8 . hdd_virtual_addr+ , recRow 4 "size" . oxhex8 . hdd_size+ ] -ppSectionHeader :: SectionHeader -> Doc-ppSectionHeader a = - tableProlog "SECTION HEADER" (24,6) (applyfs fields a)+ppSectionHeader :: SectionHeader -> VDoc+ppSectionHeader = mkTable "SECTION HEADER" . vcat . sequence fields 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)- ]+ [ recRow 8 "name" . text . sh_name+ , recRow 4 "virtual size" . oxhex8 . sh_virtual_size+ , recRow 4 "virtual addr" . oxhex8 . sh_virtual_addr+ , recRow 4 "size of raw data" . oxhex8 . sh_size_raw_data+ , recRow 4 "ptr to raw data" . oxhex8 . sh_ptr_raw_data+ , recRow 4 "ptr to relocations" . oxhex8 . sh_ptr_relocations+ , recRow 4 "ptr to line numbers" . oxhex8 . sh_ptr_linenums+ , recRow 2 "num of relocations" . oxhex4 . sh_num_relocations+ , recRow 2 "num of line numbers" . oxhex4 . sh_num_linenums+ , recRow 4 "characteristics" . oxhex8 . 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)+ppExportData :: ExportData -> VDoc+ppExportData = vconcat . sequence tables+ where+ tables = + [ ppExportDirectoryTable . ed_directory_table+ , ppExportAddressTable . ed_export_address_table+ , ppExportNamePtrTable . ed_name_ptr_table+ , ppExportOrdinalTable . ed_ordinal_table+ , ppExportNames . ed_name_table+ ] -ppExportDirectoryTable :: ExportDirectoryTable -> Doc-ppExportDirectoryTable a = - tableProlog ".edata (Export directory table)" (24,6) (applyfs fields a)+ppExportDirectoryTable :: ExportDirectoryTable -> VDoc+ppExportDirectoryTable = + mkTable ".edata (Export directory table)" . vcat . sequence fields 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)- ]+ [ recRow 8 "export flags" . oxhex8 . edt_export_flags+ , recRow 8 "timedate stamp" . oxhex8 . edt_timedate_stamp+ , recRow 4 "major version" . oxhex4 . edt_major_version+ , recRow 4 "minor version" . oxhex4 . edt_minor_version+ , recRow 8 "name rva" . oxhex8 . edt_name_rva+ , recRow 8 "oridinal base" . oxhex8 . edt_ordinal_base+ , recRow 8 "addr table entries" . oxhex8 . edt_num_addr_table_entries+ , recRow 8 "num name ptrs" . oxhex8 . edt_num_name_ptrs+ , recRow 8 "export addr table rva" . oxhex8 . edt_export_addr_table_rva+ , recRow 8 "name ptr rva" . oxhex8 . edt_name_ptr_table_rva+ , recRow 8 "ordinal table rva" . oxhex8 . edt_ordinal_table_rva+ ] -ppExportAddressTable :: ExportAddressTable -> Doc-ppExportAddressTable a = - tableProlog "Export address" (24,6) (map field $ getExportAddressTable a)+++ppExportAddressTable :: ExportAddressTable -> VDoc+ppExportAddressTable = + mkTable "Export address" . vcat . map mkRow . getExportAddressTable 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+ mkRow (EA_Export_RVA n) = row3 (int 8) (text "export RVA") (oxhex8 n)+ mkRow (EA_Forwarder_RVA n) = row3 (int 8) (text "forwarder RVA") (oxhex8 n) -ppExportNamePtrTable :: [Word32] -> Doc-ppExportNamePtrTable a = - tableProlog "Export name pointers" (24,6) (map field a)+ppExportNamePtrTable :: [Word32] -> VDoc+ppExportNamePtrTable xs = mkTable "Export name pointers" $ vcat $ map mkRow xs where- ppf = ppField 4 24- field = ppf 8 "name ptr" (ppHex 8)+ mkRow = row3 (int 8) (text "name ptr") . oxhex8 -ppExportOrdinalTable :: [Word16] -> Doc-ppExportOrdinalTable a = - tableProlog "Export ordinals" (24,6) (map field a)+ppExportOrdinalTable :: [Word16] -> VDoc+ppExportOrdinalTable xs = mkTable "Export ordinals" $ vcat $ map mkRow xs where- ppf = ppField 4 24- field = ppf 4 "ordinal" (ppHex 4) + mkRow = row3 (int 4) (text "ordinal") . oxhex4 -ppExportNames :: [String] -> Doc-ppExportNames a = - tableProlog "Export names" (24,6) (map field a)+ppExportNames :: [String] -> VDoc+ppExportNames xs = mkTable "Export names" $ vcat $ map mkRow xs where- ppf = ppField 4 24- field = ppf 4 "export name" text + mkRow = row3 (text "-") (text "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")+-- 4r-24r-24l +colHeadings :: VDoc +colHeadings = vdoc $ row3 (text "size") (text "field") (text "value") -columnSep :: Doc-columnSep = text $ replicate 60 '-' +row3 :: Doc -> Doc -> Doc -> Doc+row3 = row dblspace (alignRight 4 $ alignRight 24 $ alignLeft 24 $ endrow) +recRow :: Int -> String -> Doc -> Doc+recRow fsize name doc = row3 (int fsize) (text name) doc -ppField :: Int -> Int -> Int -> String -> (a -> Doc) -> a -> Doc-ppField n1 n2 sz field_name f a = text sz' <+> text field_name' <+> f a+type TableName = String++mkTable :: TableName -> VDoc -> VDoc+mkTable tname rows = title `vcons` (block1 `vappend` rows) where- sz' = pad n1 ' ' (show sz)- field_name' = pad n2 ' ' field_name+ title = text tname+ block1 = vconcat [rowSep, colHeadings, rowSep] -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+rowSep :: VDoc+rowSep = vdoc $ replicateChar 60 '-' -listDoc :: [Doc] -> Doc-listDoc = brackets . punctuate comma +-- TO ADD TO JoinPrint+list :: [Doc] -> Doc+list = brackets . punctuate comma++vdoc :: Doc -> VDoc+vdoc = vcat . return++vappend :: VDoc -> VDoc -> VDoc+vappend a b = vconcat [a,b]