hurdle-0.4.0: src/Hurdle/Coff/Parser.hs
{-# OPTIONS -Wall #-}
--------------------------------------------------------------------------------
-- |
-- Module : Hurdle.Coff.Parser
-- Copyright : (c) Stephen Tetley 2009-2010
-- License : BSD3
--
-- Maintainer : Stephen Tetley <stephen.tetley@gmail.com>
-- 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 (,,,) anyChar anyChar anyChar anyChar
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 anyChar)
-- 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)