hurdle-0.2.0: src/Hurdle/TextDump.hs
{-# OPTIONS -Wall #-}
--------------------------------------------------------------------------------
-- |
-- Module : Hurdle.TextDump
-- Copyright : (c) Stephen Tetley 2009
-- License : BSD3
--
-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>
-- Stability : highly unstable
-- Portability :
--
-- Pretty print as text...
--
--------------------------------------------------------------------------------
module Hurdle.TextDump where
import Hurdle.Datatypes
import qualified Data.Map as Map
import Data.Word
import Numeric
import Text.PrettyPrint.HughesPJ
-- applyfs is 'sequence' from Control.Monad but I don't to drag in
-- Control.Monad.Instances
--
applyfs :: [(a -> b)] -> a -> [b]
applyfs [] _ = []
applyfs (f:fs) a = f a : applyfs fs a
printImage :: Image -> IO ()
printImage = putStr . imageText
imageText :: Image -> String
imageText = renderStyle (Style PageMode 80 1.5) . ppImage
ppImage :: Image -> Doc
ppImage a =
ppImageDOSHeader (image_dos_header a)
$+$ columnSep
$+$ ppSignature (image_signature a)
$+$ ppImageCOFFHeader (image_coff_header a)
$+$ ppImageOptionalHeader (image_opt_header a)
$+$ (vcat $ map ppSectionHeader $ Map.elems $ image_section_headers a)
$+$ maybe empty ppExportData (image_export_data a)
ppImageDOSHeader :: ImageDOSHeader -> Doc
ppImageDOSHeader a =
tableProlog "IMAGE_DOS_HEADER" (24,6) (applyfs fields a)
where
ppf = ppField 4 24
fields =
[ ppf 2 "magic" (ppHex 4 . idh_magic_number)
, ppf 2 "bytes last page" (ppHex 4 . idh_bytes_last_page)
, ppf 2 "pages in file" (ppHex 4 . idh_pages_in_file)
, ppf 2 "relocations" (ppHex 4 . idh_relocations)
, ppf 2 "header para size" (ppHex 4 . idh_size_header_paras)
, ppf 2 "min extra paragraphs" (ppHex 4 . idh_min_extra_paras)
, ppf 2 "max extra paragraphs" (ppHex 4 . idh_max_extra_paras)
, ppf 2 "initial SS value" (ppHex 4 . idh_initial_relative_ss)
, ppf 2 "initial SP value" (ppHex 4 . idh_initial_sp)
, ppf 2 "checksum" (ppHex 4 . idh_header_checksum)
, ppf 2 "initial IP value" (ppHex 4 . idh_initial_ip)
, ppf 2 "initial CS value" (ppHex 4 . idh_initial_relative_cs)
, ppf 2 "relocation table addr" (ppHex 4 . idh_reltable_file_addr)
, ppf 2 "overlay number" (ppHex 4 . idh_overlay_number)
, ppf 8 "reserved 1" (tup4 . idh_reserved_words)
, ppf 2 "oem identifier" (ppHex 4 . idh_oem_identifier)
, ppf 2 "oem info" (ppHex 4 . idh_oem_info)
, ppf 20 "reserved 2" (text . show . idh_reserved_words_two)
, ppf 4 "new exe header addr" (ppHex 8 . idh_new_exe_header_addr)
]
tup4 (s,t,u,v) = text $ show [s,t,u,v]
ppSignature :: (Char,Char,Char,Char) -> Doc
ppSignature (s,t,u,v) =
text "Signature:" <+> (listDoc $ map (text . show) [s,t,u,v])
ppImageCOFFHeader :: ImageCOFFHeader -> Doc
ppImageCOFFHeader a =
tableProlog "IMAGE COFF HEADER" (24,6) (applyfs fields a)
where
ppf = ppField 4 24
fields =
[ ppf 2 "machine" (ppHex 4 . ich_machine)
, ppf 2 "num sections" (ppHex 4 . ich_num_sections)
, ppf 4 "timedatestamp" (ppHex 8 . ich_timedate_stamp)
, ppf 4 "ptr to sym table" (ppHex 8 . ich_sym_table_ptr)
, ppf 4 "num symbols" (ppHex 8 . ich_num_symbols)
, ppf 2 "size optional header" (ppHex 4 . ich_opt_header_size)
, ppf 2 "characteristics" (ppHex 4 . ich_characteristics)
]
ppImageOptionalHeader :: ImageOptionalHeader -> Doc
ppImageOptionalHeader a =
ppImageOptionalStandard (ioh_header_std_fields a)
$+$ ppImageOptionalNTSpecific (ioh_nt_specific_fields a)
$+$ (vcat $ zipWith ppImageDataDirectory names (ioh_data_directory a))
where
names = [ ".edata"
, ".idata"
, ".rsrc"
, ".pdata"
, "attribute certificate table"
, ".reloc"
, ".debug"
, "architecture"
, "global ptr"
, ".tls"
, "load config"
, "bound impact"
, "import address table"
, "delay import descriptor"
, ".cormeta"
, "reserved"
]
ppImageOptionalStandard :: ImageOptionalStandard -> Doc
ppImageOptionalStandard a =
tableProlog "IMAGE OPTIONAL HEADER STANDARD" (24,6) (applyfs fields a)
where
ppf = ppField 4 24
fields =
[ ppf 2 "magic" (ppHex 4 . ios_magic)
, ppf 1 "major linker ver." (ppHex 2 . ios_major_linker_version)
, ppf 1 "minor linker ver." (ppHex 2 . ios_minor_linker_version)
, ppf 4 "size of code" (ppHex 8 . ios_size_of_code)
, ppf 4 "size of init. data" (ppHex 8 . ios_size_of_inited_data)
, ppf 4 "size of uninit. data" (ppHex 8 . ios_size_of_uninited_data)
, ppf 4 "entry ptr addr" (ppHex 8 . ios_entry_point_addr)
, ppf 4 "base of code" (ppHex 8 . ios_base_of_code)
, ppf 4 "base of data" (ppHex 8 . ios_base_of_data)
]
ppImageOptionalNTSpecific :: ImageOptionalNTSpecific -> Doc
ppImageOptionalNTSpecific a =
tableProlog "IMAGE OPTIONAL HEADER NT SPECIFIC" (24,6) (applyfs fields a)
where
ppf = ppField 4 24
fields =
[ ppf 4 "image base" (ppHex 8 . iont_image_base)
, ppf 4 "section alignment" (ppHex 8 . iont_section_alignment)
, ppf 4 "file alignment" (ppHex 8 . iont_file_alignment)
, ppf 2 "major os version" (ppHex 4 . iont_major_os_version)
, ppf 2 "minor os version" (ppHex 4 . iont_minor_os_version)
, ppf 2 "major image version" (ppHex 4 . iont_major_image_version)
, ppf 2 "minor image version" (ppHex 4 . iont_minor_image_version)
, ppf 2 "major subsys version" (ppHex 4 . iont_major_subsys_version)
, ppf 2 "minor subsys version" (ppHex 4 . iont_minor_subsys_version)
, ppf 4 "win32 version" (ppHex 8 . iont_win32_version)
, ppf 4 "size of image" (ppHex 8 . iont_size_of_image)
, ppf 4 "size of headers" (ppHex 8 . iont_size_of_headers)
, ppf 4 "checksum" (ppHex 8 . iont_checksum)
, ppf 2 "subsystem" (ppHex 4 . iont_subsystem)
, ppf 2 "dll characteristics" (ppHex 4 . iont_dll_characteristics)
, ppf 4 "size of stack reserve" (ppHex 8 . iont_size_stack_reserve)
, ppf 4 "size of stack commit" (ppHex 8 . iont_size_stack_commit)
, ppf 4 "size of heap reserve" (ppHex 8 . iont_size_heap_reserve)
, ppf 4 "size of heap commit" (ppHex 8 . iont_size_heap_commit)
, ppf 4 "loader flags" (ppHex 8 . iont_loader_flags)
, ppf 4 "rva num and sizes" (ppHex 8 . iont_rva_num_and_sizes)
]
ppImageDataDirectory :: String -> ImageDataDirectory -> Doc
ppImageDataDirectory s a =
tableProlog s (24,6) (applyfs fields a)
where
ppf = ppField 4 24
fields =
[ ppf 4 "virtual address" (ppHex 8 . idd_virtual_addr)
, ppf 4 "size" (ppHex 8 . idd_size)
]
ppSectionHeader :: SectionHeader -> Doc
ppSectionHeader a =
tableProlog "SECTION HEADER" (24,6) (applyfs fields a)
where
ppf = ppField 4 24
fields =
[ ppf 8 "name" (text . sh_name)
, ppf 4 "virtual size" (ppHex 8 . sh_virtual_size)
, ppf 4 "virtual addr" (ppHex 8 . sh_virtual_addr)
, ppf 4 "size of raw data" (ppHex 8 . sh_size_raw_data)
, ppf 4 "ptr to raw data" (ppHex 8 . sh_ptr_raw_data)
, ppf 4 "ptr to relocations" (ppHex 8 . sh_ptr_relocations)
, ppf 4 "ptr to line numbers" (ppHex 8 . sh_ptr_linenums)
, ppf 2 "num of relocations" (ppHex 4 . sh_num_relocations)
, ppf 2 "num of line numbers" (ppHex 4 . sh_num_linenums)
, ppf 4 "characteristics" (ppHex 8 . sh_characteristics)
]
ppExportData :: ExportData -> Doc
ppExportData a =
ppExportDirectoryTable (ed_directory_table a)
$+$ ppExportAddressTable (ed_export_address_table a)
$+$ ppExportNamePtrTable (ed_name_ptr_table a)
$+$ ppExportOrdinalTable (ed_ordinal_table a)
$+$ ppExportNames (ed_name_table a)
ppExportDirectoryTable :: ExportDirectoryTable -> Doc
ppExportDirectoryTable a =
tableProlog ".edata (Export directory table)" (24,6) (applyfs fields a)
where
ppf = ppField 4 24
fields =
[ ppf 8 "export flags" (ppHex 8 . edt_export_flags)
, ppf 8 "timedate stamp" (ppHex 8 . edt_timedate_stamp)
, ppf 4 "major version" (ppHex 4 . edt_major_version)
, ppf 4 "minor version" (ppHex 4 . edt_minor_version)
, ppf 8 "name rva" (ppHex 8 . edt_name_rva)
, ppf 8 "oridinal base" (ppHex 8 . edt_ordinal_base)
, ppf 8 "addr table entries" (ppHex 8 . edt_num_addr_table_entries)
, ppf 8 "num name ptrs" (ppHex 8 . edt_num_name_ptrs)
, ppf 8 "export addr table rva" (ppHex 8 . edt_export_addr_table_rva)
, ppf 8 "name ptr rva" (ppHex 8 . edt_name_ptr_table_rva)
, ppf 8 "ordinal table rva" (ppHex 8 . edt_ordinal_table_rva)
]
ppExportAddressTable :: ExportAddressTable -> Doc
ppExportAddressTable a =
tableProlog "Export address" (24,6) (map field $ getExportAddressTable a)
where
ppf = ppField 4 24
field (EA_Export_RVA w32) = ppf 8 "export RVA" (ppHex 8) w32
field (EA_Forwarder_RVA w32) = ppf 8 "forwarder RVA" (ppHex 8) w32
ppExportNamePtrTable :: [Word32] -> Doc
ppExportNamePtrTable a =
tableProlog "Export name pointers" (24,6) (map field a)
where
ppf = ppField 4 24
field = ppf 8 "name ptr" (ppHex 8)
ppExportOrdinalTable :: [Word16] -> Doc
ppExportOrdinalTable a =
tableProlog "Export ordinals" (24,6) (map field a)
where
ppf = ppField 4 24
field = ppf 4 "ordinal" (ppHex 4)
ppExportNames :: [String] -> Doc
ppExportNames a =
tableProlog "Export names" (24,6) (map field a)
where
ppf = ppField 4 24
field = ppf 4 "export name" text
--------------------------------------------------------------------------------
-- Helpers
tableProlog :: String -> (Int,Int) -> [Doc] -> Doc
tableProlog s (m,n) ds =
columnSep
$+$ text s
$+$ columnSep
$+$ columnHeadings m n
$+$ columnSep
$+$ vcat ds
where
columnHeadings fsz vsz =
text "size" <+> text (pad fsz ' ' "field") <+> text (pad vsz ' ' "value")
columnSep :: Doc
columnSep = text $ replicate 60 '-'
ppField :: Int -> Int -> Int -> String -> (a -> Doc) -> a -> Doc
ppField n1 n2 sz field_name f a = text sz' <+> text field_name' <+> f a
where
sz' = pad n1 ' ' (show sz)
field_name' = pad n2 ' ' field_name
ppHex :: Integral a => Int -> a -> Doc
ppHex n i = text "0x" <> (text $ pad n '0' $ showHex i "")
pad :: Int -> Char -> String -> String
pad n ch s | length s < n = replicate (n - length s) ch ++ s
| otherwise = s
listDoc :: [Doc] -> Doc
listDoc = brackets . hcat . punctuate comma