module Data.PE.Parser (buildFile, buildFileFromBS) where
import Data.PE.Structures
import Data.PE.Utils
import qualified Data.ByteString.Lazy as B
import Data.Binary.Get
import Data.Maybe
buildFile :: String
-> IO (PEFile)
buildFile fName = do
fbstring <- B.readFile fName
return $ buildFileFromBS fbstring
buildFileFromBS :: B.ByteString
-> PEFile
buildFileFromBS fbstring =
let peheader = (runGet pheader fbstring) in
let mapSections = \sections' -> (secBytes fbstring sections') in
let secTables = sectionTables peheader in
let binsections = map mapSections $ map fst secTables in
let fixsec = \x -> (x, fromJust $ lookup (sectionHeaderName x) binsections) in
let newsections = map fixsec $ map fst secTables in
PEFile{peHeader=peheader{sectionTables=newsections}}
pheader :: Get (PEHeader)
pheader = do
dosheader <- buildMSDOSHead
bytes <- bytesRead
let peoffset = (fromIntegral (offset dosheader)) (fromIntegral bytes)
skip peoffset
peSig <- buildPESignature
coff <- buildCOFFHeader
sfheader <- buildSFHeader
wsfheader <- if (standardSig sfheader == 0x10B) then buildWSFHeader else buildWSFPlus
datadirs <- buildDataDirectories (fromIntegral $ numberOfRVAandSizes wsfheader)
let numsections = fromIntegral (numberOfSections coff)
sectables <- sections numsections
let sectables' = map (\x -> (x,B.pack [])) sectables
return PEHeader {msdosHeader=dosheader, peSignature=peSig, coffHeader=coff, standardFields=sfheader,
windowsSpecFields=wsfheader, dataDirectories=datadirs, sectionTables=sectables'}
sections :: Int -> Get ([SectionTable])
sections 0 = return []
sections n = sections (n 1) >>= \rest -> buildSectionTable >>= \item -> return (item:rest)
secBytes :: B.ByteString -> SectionTable -> (String,B.ByteString)
secBytes bs sec = let offset' = (fromIntegral . pointerToRawData) sec in
let size = (fromIntegral . sizeOfRawData) sec in
let name = sectionHeaderName sec in
let pbs = B.drop offset' bs in
let sbs = B.take size pbs in
(name, sbs)
buildMSDOSHead :: Get (MSDOSHeader)
buildMSDOSHead = do
signature' <- getWord16le
lastsize' <- getWord16le
pagesInFile' <- getWord16le
relocations' <- getWord16le
headerSizeInParagraph' <- getWord16le
minExtraParagraphs' <- getWord16le
maxExtraParagraphs' <- getWord16le
ss' <- getWord16le
sp' <- getWord16le
checksum' <- getWord16le
ip' <- getWord16le
cs' <- getWord16le
relocTableOffset' <- getWord16le
overlayNumber' <- getWord16le
_ <- getWord16le
_ <- getWord16le
_ <- getWord16le
_ <- getWord16le
oemIdentifier' <- getWord16le
oemInformation' <- getWord16le
_ <- getWord32le
_ <-getWord32le
_ <-getWord32le
_ <-getWord32le
_ <-getWord32le
offset' <- getWord32le
let header' = MSDOSHeader {signature=signature', lastsize=lastsize', pagesInFile=pagesInFile',
relocations=relocations', headerSizeInParagraph=headerSizeInParagraph',
minExtraParagraphs=minExtraParagraphs', maxExtraParagraphs=maxExtraParagraphs',
ss=ss', sp=sp', checksum=checksum', ip=ip', cs=cs',
relocTableOffset=relocTableOffset', overlayNumber=overlayNumber',
oemIdentifier=oemIdentifier', oemInformation=oemInformation', offset=offset'}
return header'
buildPESignature :: Get (PESignature)
buildPESignature = do
sig <- getWord32le
return PESignature { pesignature=sig }
buildCOFFHeader :: Get (COFFHeader)
buildCOFFHeader = do
targetMachine' <- getWord16le
numberOfSections' <- getWord16le
timeDateStamp' <- getWord32le
pointerToSymbolTable' <- getWord32le
numberOfSymbols' <- getWord32le
sizeofOptionalHeaders' <- getWord16le
coffCharacteristics' <- getWord16le
let header' = COFFHeader { targetMachine=(mapMachine targetMachine'), numberOfSections=numberOfSections',
timeDateStamp=timeDateStamp', pointerToSymbolTable=pointerToSymbolTable',
numberOfSymbols=numberOfSymbols', sizeofOptionalHeaders=sizeofOptionalHeaders',
coffCharacteristics=coffCharacteristics'}
return header'
buildSFHeader :: Get (StandardFields)
buildSFHeader = do
standardSig' <- getWord16le
lnMajorVersion' <- getWord8
lnMinorVersion' <- getWord8
sizeOfCode' <- getWord32le
sizeOfInitializedData' <- getWord32le
sizeOfUninitData' <- getWord32le
addressOfEntryPoint' <- getWord32le
baseOfCode' <- getWord32le
case (standardSig') of
0x10B -> do
baseOfData' <- getWord32le
let header' = StandardFields { standardSig=standardSig', lnMajorVersion=lnMajorVersion',
lnMinorVersion=lnMinorVersion', sizeOfCode=sizeOfCode', sizeOfInitializedData=sizeOfInitializedData',
sizeOfUninitData=sizeOfUninitData', addressOfEntryPoint=addressOfEntryPoint',
baseOfCode=baseOfCode', baseOfData=baseOfData'}
return header'
0x20B -> do
let header' = SFPlus { standardSig=standardSig', lnMajorVersion=lnMajorVersion',
lnMinorVersion=lnMinorVersion', sizeOfCode=sizeOfCode', sizeOfInitializedData=sizeOfInitializedData',
sizeOfUninitData=sizeOfUninitData', addressOfEntryPoint=addressOfEntryPoint',
baseOfCode=baseOfCode'}
return header'
_ -> error "Unrecognized PE format Magic Number"
buildWSFHeader :: Get (WindowsSpecFields)
buildWSFHeader = do
imageBase' <- getWord32le
sectionAlignment' <- getWord32le
fileAlignment' <- getWord32le
majorOSVersion' <- getWord16le
minorOSVersion' <- getWord16le
majorImageVersion' <- getWord16le
minorImageVersion' <- getWord16le
majorSubSystemVersion' <- getWord16le
minorSubSystemVersion' <- getWord16le
win32VersionValue' <- getWord32le
sizeOfImage' <- getWord32le
sizeOfHeaders' <- getWord32le
checkSum32' <- getWord32le
checkSum16' <- getWord16le
dllCharacteristics' <- getWord16le
sizeOfStackReserve' <- getWord32le
sizeOfStackCommit' <- getWord32le
sizeOfHeapReserve' <- getWord32le
sizeOfHeapCommit' <- getWord32le
loaderFlags' <- getWord32le
numberOfRVAandSizes' <- getWord32le
let header' = WindowsSpecFields { imageBase=imageBase', sectionAlignment=sectionAlignment',
fileAlignment=fileAlignment', majorOSVersion=majorOSVersion',
minorOSVersion=minorOSVersion', majorImageVersion=majorImageVersion',
minorImageVersion=minorImageVersion', majorSubSystemVersion=majorSubSystemVersion',
minorSubSystemVersion=minorSubSystemVersion', win32VersionValue=win32VersionValue',
sizeOfImage=sizeOfImage', sizeOfHeaders=sizeOfHeaders', checkSum32=checkSum32',
checkSum16=checkSum16', dllCharacteristics=dllCharacteristics', sizeOfStackReserve=sizeOfStackReserve',
sizeOfStackCommit=sizeOfStackCommit', sizeOfHeapReserve=sizeOfHeapReserve',
sizeOfHeapCommit=sizeOfHeapCommit', loaderFlags=loaderFlags', numberOfRVAandSizes=numberOfRVAandSizes' }
return header'
buildWSFPlus :: Get (WindowsSpecFields)
buildWSFPlus = do
imageBase' <- getWord64le
sectionAlignment' <- getWord32le
fileAlignment' <- getWord32le
majorOSVersion' <- getWord16le
minorOSVersion' <- getWord16le
majorImageVersion' <- getWord16le
minorImageVersion' <- getWord16le
majorSubSystemVersion' <- getWord16le
minorSubSystemVersion' <- getWord16le
win32VersionValue' <- getWord32le
sizeOfImage' <- getWord32le
sizeOfHeaders' <- getWord32le
checkSum32' <- getWord32le
checkSum16' <- getWord16le
dllCharacteristics' <- getWord16le
sizeOfStackReserve' <- getWord64le
sizeOfStackCommit' <- getWord64le
sizeOfHeapReserve' <- getWord64le
sizeOfHeapCommit' <- getWord64le
loaderFlags' <- getWord32le
numberOfRVAandSizes' <- getWord32le
let header' = WSFPlus { imgBase=imageBase', sectionAlignment=sectionAlignment',
fileAlignment=fileAlignment', majorOSVersion=majorOSVersion',
minorOSVersion=minorOSVersion', majorImageVersion=majorImageVersion',
minorImageVersion=minorImageVersion', majorSubSystemVersion=majorSubSystemVersion',
minorSubSystemVersion=minorSubSystemVersion', win32VersionValue=win32VersionValue',
sizeOfImage=sizeOfImage', sizeOfHeaders=sizeOfHeaders', checkSum32=checkSum32',
checkSum16=checkSum16', dllCharacteristics=dllCharacteristics', szOfStackReserve=sizeOfStackReserve',
szOfStackCommit=sizeOfStackCommit', szOfHeapReserve=sizeOfHeapReserve',
szOfHeapCommit=sizeOfHeapCommit', loaderFlags=loaderFlags', numberOfRVAandSizes=numberOfRVAandSizes' }
return header'
buildDataDirectories :: Int -> Get ([DirectoryEntry])
buildDataDirectories 0 = return []
buildDataDirectories i = do
addr <- getWord32le
size <- getWord32le
let entry = DirEntry {virtualAddr=addr, entrySize=size}
rest <- buildDataDirectories (i1)
return $ entry : rest
buildSectionTable :: Get (SectionTable)
buildSectionTable = do
sectionHeaderName' <- getWord64le
virtualSize' <- getWord32le
virtualAddress' <- getWord32le
sizeOfRawData' <- getWord32le
pointerToRawData' <- getWord32le
pointerToRelocations' <- getWord32le
pointerToLineNumbers' <- getWord32le
numberOfRelocations' <- getWord16le
numberOfLineNumbers' <- getWord16le
secCharacteristics' <- getWord32le
let header = SectionTable { sectionHeaderName=(byte64String sectionHeaderName'), virtualSize=virtualSize',
virtualAddress=virtualAddress', sizeOfRawData=sizeOfRawData',
pointerToRawData=pointerToRawData', pointerToRelocations=pointerToRelocations',
pointerToLineNumbers=pointerToLineNumbers', numberOfRelocations=numberOfRelocations',
numberOfLineNumbers=numberOfLineNumbers', secCharacteristics=secCharacteristics'}
return header