module Data.PE.Tools where
import Data.PE.Parser
import Data.PE.Structures
import qualified Data.ByteString.Lazy as LBS
import Data.Word
import System.IO.Unsafe
import Data.Binary
import Data.Binary.Get
import Data.Char
import Data.Bits
import Data.Array.Unboxed
import Data.List

type Filename = String
type Secname = String
type SectionMeta = (SectionTable, LBS.ByteString)

getsecandinfo :: Filename -> Secname -> IO ((Maybe SectionMeta, MachineType))
getsecandinfo :: Filename -> Filename -> IO (Maybe SectionMeta, MachineType)
getsecandinfo Filename
fn Filename
sn = Filename -> IO PEFile
buildFile Filename
fn IO PEFile
-> (PEFile -> IO (Maybe SectionMeta, MachineType))
-> IO (Maybe SectionMeta, MachineType)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PEFile
pefile -> (Maybe SectionMeta, MachineType)
-> IO (Maybe SectionMeta, MachineType)
forall (m :: * -> *) a. Monad m => a -> m a
return (PEFile -> Filename -> Maybe SectionMeta
getsection PEFile
pefile Filename
sn, PEFile -> MachineType
getmachinetype PEFile
pefile)

getsec :: Filename -> Secname -> IO (Maybe SectionMeta)
getsec :: Filename -> Filename -> IO (Maybe SectionMeta)
getsec Filename
fn Filename
sn = Filename -> IO PEFile
buildFile Filename
fn IO PEFile
-> (PEFile -> IO (Maybe SectionMeta)) -> IO (Maybe SectionMeta)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PEFile
pefile -> Maybe SectionMeta -> IO (Maybe SectionMeta)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SectionMeta -> IO (Maybe SectionMeta))
-> Maybe SectionMeta -> IO (Maybe SectionMeta)
forall a b. (a -> b) -> a -> b
$ PEFile -> Filename -> Maybe SectionMeta
getsection PEFile
pefile Filename
sn

getsecs :: Filename -> [SectionMeta]
getsecs :: Filename -> [SectionMeta]
getsecs Filename
fn = IO [SectionMeta] -> [SectionMeta]
forall a. IO a -> a
unsafePerformIO (Filename -> IO PEFile
buildFile Filename
fn IO PEFile -> (PEFile -> IO [SectionMeta]) -> IO [SectionMeta]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PEFile
pefile -> [SectionMeta] -> IO [SectionMeta]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SectionMeta] -> IO [SectionMeta])
-> [SectionMeta] -> IO [SectionMeta]
forall a b. (a -> b) -> a -> b
$ (PEHeader -> [SectionMeta]
sectionTables(PEHeader -> [SectionMeta])
-> (PEFile -> PEHeader) -> PEFile -> [SectionMeta]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PEFile -> PEHeader
peHeader) PEFile
pefile)

getary :: Filename -> UArray Word32 Word8
getary :: Filename -> UArray Word32 Word8
getary Filename
fn = [SectionMeta] -> UArray Word32 Word8
arrayrep ([SectionMeta] -> UArray Word32 Word8)
-> [SectionMeta] -> UArray Word32 Word8
forall a b. (a -> b) -> a -> b
$ Filename -> [SectionMeta]
getsecs Filename
fn

getdirs :: Filename -> [DirectoryEntry]
getdirs :: Filename -> [DirectoryEntry]
getdirs Filename
fn = IO [DirectoryEntry] -> [DirectoryEntry]
forall a. IO a -> a
unsafePerformIO (Filename -> IO PEFile
buildFile Filename
fn IO PEFile -> (PEFile -> IO [DirectoryEntry]) -> IO [DirectoryEntry]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \PEFile
pefile -> [DirectoryEntry] -> IO [DirectoryEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return ([DirectoryEntry] -> IO [DirectoryEntry])
-> [DirectoryEntry] -> IO [DirectoryEntry]
forall a b. (a -> b) -> a -> b
$ (PEHeader -> [DirectoryEntry]
dataDirectories(PEHeader -> [DirectoryEntry])
-> (PEFile -> PEHeader) -> PEFile -> [DirectoryEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PEFile -> PEHeader
peHeader) PEFile
pefile)

getsection :: PEFile -> Secname -> Maybe SectionMeta
getsection :: PEFile -> Filename -> Maybe SectionMeta
getsection PEFile
pefile Filename
secn = let sections :: [SectionMeta]
sections = (PEHeader -> [SectionMeta]
sectionTables(PEHeader -> [SectionMeta])
-> (PEFile -> PEHeader) -> PEFile -> [SectionMeta]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PEFile -> PEHeader
peHeader) PEFile
pefile in
                          (SectionMeta -> Bool) -> [SectionMeta] -> Maybe SectionMeta
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\SectionMeta
x -> Filename
secn Filename -> Filename -> Bool
forall a. Eq a => a -> a -> Bool
== (SectionTable -> Filename
sectionHeaderName (SectionTable -> Filename) -> SectionTable -> Filename
forall a b. (a -> b) -> a -> b
$ SectionMeta -> SectionTable
forall a b. (a, b) -> a
fst SectionMeta
x)) [SectionMeta]
sections 

getmachinetype :: PEFile -> MachineType
getmachinetype :: PEFile -> MachineType
getmachinetype PEFile
pe = COFFHeader -> MachineType
targetMachine (COFFHeader -> MachineType) -> COFFHeader -> MachineType
forall a b. (a -> b) -> a -> b
$ PEHeader -> COFFHeader
coffHeader (PEHeader -> COFFHeader) -> PEHeader -> COFFHeader
forall a b. (a -> b) -> a -> b
$ PEFile -> PEHeader
peHeader PEFile
pe

showsections :: Filename -> IO ()
showsections :: Filename -> IO ()
showsections Filename
filename = do
                           PEFile
pefile <- Filename -> IO PEFile
buildFile Filename
filename
                           let sections :: [SectionMeta]
sections = (PEHeader -> [SectionMeta]
sectionTables(PEHeader -> [SectionMeta])
-> (PEFile -> PEHeader) -> PEFile -> [SectionMeta]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PEFile -> PEHeader
peHeader) PEFile
pefile
                           let coff :: COFFHeader
coff = (PEHeader -> COFFHeader
coffHeader(PEHeader -> COFFHeader)
-> (PEFile -> PEHeader) -> PEFile -> COFFHeader
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PEFile -> PEHeader
peHeader) PEFile
pefile
                           let std :: StandardFields
std = (PEHeader -> StandardFields
standardFields(PEHeader -> StandardFields)
-> (PEFile -> PEHeader) -> PEFile -> StandardFields
forall b c a. (b -> c) -> (a -> b) -> a -> c
.PEFile -> PEHeader
peHeader) PEFile
pefile
                           let showme :: (SectionTable, b) -> Filename
showme = \(SectionTable, b)
x -> (SectionTable -> Filename
sectionHeaderName (SectionTable -> Filename) -> SectionTable -> Filename
forall a b. (a -> b) -> a -> b
$ (SectionTable, b) -> SectionTable
forall a b. (a, b) -> a
fst (SectionTable, b)
x)
                           --putStr $ show datadirs
                           Filename -> IO ()
putStr (Filename -> IO ()) -> Filename -> IO ()
forall a b. (a -> b) -> a -> b
$ COFFHeader -> Filename
forall a. Show a => a -> Filename
show (COFFHeader -> Filename) -> COFFHeader -> Filename
forall a b. (a -> b) -> a -> b
$ COFFHeader
coff
                           Filename -> IO ()
putStr (Filename -> IO ()) -> Filename -> IO ()
forall a b. (a -> b) -> a -> b
$ StandardFields -> Filename
forall a. Show a => a -> Filename
show (StandardFields -> Filename) -> StandardFields -> Filename
forall a b. (a -> b) -> a -> b
$ StandardFields
std
                           Filename -> IO ()
putStr (Filename -> IO ()) -> Filename -> IO ()
forall a b. (a -> b) -> a -> b
$ [Filename] -> Filename
forall a. Show a => a -> Filename
show ([Filename] -> Filename) -> [Filename] -> Filename
forall a b. (a -> b) -> a -> b
$ (SectionMeta -> Filename) -> [SectionMeta] -> [Filename]
forall a b. (a -> b) -> [a] -> [b]
map SectionMeta -> Filename
forall b. (SectionTable, b) -> Filename
showme [SectionMeta]
sections 
                           --putStr $ show $ (numberOfRVAandSizes.windowsSpecFields.peHeader) pefile
                           --putStr $ show pefile
                           () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () 


--Import Table Parsing stuff.  This should eventually move to the PE library.

type ImportDirectory = [ImportDirectoryEntry]
type ImportLookupTable = [ImportLookupTableEntry]

data ImportDirectoryEntry = ID {
                                ImportDirectoryEntry -> Word32
lookupTableRVA :: Word32,
                                ImportDirectoryEntry -> Word32
timeStamp :: Word32,
                                ImportDirectoryEntry -> Word32
forwarderChain :: Word32,
                                ImportDirectoryEntry -> Word32
nameRVA :: Word32,
                                ImportDirectoryEntry -> Word32
importAddressTableRVA :: Word32
                               } | IDNull deriving (Int -> ImportDirectoryEntry -> ShowS
[ImportDirectoryEntry] -> ShowS
ImportDirectoryEntry -> Filename
(Int -> ImportDirectoryEntry -> ShowS)
-> (ImportDirectoryEntry -> Filename)
-> ([ImportDirectoryEntry] -> ShowS)
-> Show ImportDirectoryEntry
forall a.
(Int -> a -> ShowS) -> (a -> Filename) -> ([a] -> ShowS) -> Show a
showList :: [ImportDirectoryEntry] -> ShowS
$cshowList :: [ImportDirectoryEntry] -> ShowS
show :: ImportDirectoryEntry -> Filename
$cshow :: ImportDirectoryEntry -> Filename
showsPrec :: Int -> ImportDirectoryEntry -> ShowS
$cshowsPrec :: Int -> ImportDirectoryEntry -> ShowS
Show,ImportDirectoryEntry -> ImportDirectoryEntry -> Bool
(ImportDirectoryEntry -> ImportDirectoryEntry -> Bool)
-> (ImportDirectoryEntry -> ImportDirectoryEntry -> Bool)
-> Eq ImportDirectoryEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportDirectoryEntry -> ImportDirectoryEntry -> Bool
$c/= :: ImportDirectoryEntry -> ImportDirectoryEntry -> Bool
== :: ImportDirectoryEntry -> ImportDirectoryEntry -> Bool
$c== :: ImportDirectoryEntry -> ImportDirectoryEntry -> Bool
Eq)

data HintNameEntry = HNE { 
                           HintNameEntry -> Word16
hint :: Word16,
                           HintNameEntry -> Filename
name :: String
                         } deriving (Int -> HintNameEntry -> ShowS
[HintNameEntry] -> ShowS
HintNameEntry -> Filename
(Int -> HintNameEntry -> ShowS)
-> (HintNameEntry -> Filename)
-> ([HintNameEntry] -> ShowS)
-> Show HintNameEntry
forall a.
(Int -> a -> ShowS) -> (a -> Filename) -> ([a] -> ShowS) -> Show a
showList :: [HintNameEntry] -> ShowS
$cshowList :: [HintNameEntry] -> ShowS
show :: HintNameEntry -> Filename
$cshow :: HintNameEntry -> Filename
showsPrec :: Int -> HintNameEntry -> ShowS
$cshowsPrec :: Int -> HintNameEntry -> ShowS
Show, HintNameEntry -> HintNameEntry -> Bool
(HintNameEntry -> HintNameEntry -> Bool)
-> (HintNameEntry -> HintNameEntry -> Bool) -> Eq HintNameEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HintNameEntry -> HintNameEntry -> Bool
$c/= :: HintNameEntry -> HintNameEntry -> Bool
== :: HintNameEntry -> HintNameEntry -> Bool
$c== :: HintNameEntry -> HintNameEntry -> Bool
Eq)

data ImportLookupTableEntry = ILTOrd Word16 | ILTHint Word32 | ILTNull deriving (Int -> ImportLookupTableEntry -> ShowS
[ImportLookupTableEntry] -> ShowS
ImportLookupTableEntry -> Filename
(Int -> ImportLookupTableEntry -> ShowS)
-> (ImportLookupTableEntry -> Filename)
-> ([ImportLookupTableEntry] -> ShowS)
-> Show ImportLookupTableEntry
forall a.
(Int -> a -> ShowS) -> (a -> Filename) -> ([a] -> ShowS) -> Show a
showList :: [ImportLookupTableEntry] -> ShowS
$cshowList :: [ImportLookupTableEntry] -> ShowS
show :: ImportLookupTableEntry -> Filename
$cshow :: ImportLookupTableEntry -> Filename
showsPrec :: Int -> ImportLookupTableEntry -> ShowS
$cshowsPrec :: Int -> ImportLookupTableEntry -> ShowS
Show,ImportLookupTableEntry -> ImportLookupTableEntry -> Bool
(ImportLookupTableEntry -> ImportLookupTableEntry -> Bool)
-> (ImportLookupTableEntry -> ImportLookupTableEntry -> Bool)
-> Eq ImportLookupTableEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportLookupTableEntry -> ImportLookupTableEntry -> Bool
$c/= :: ImportLookupTableEntry -> ImportLookupTableEntry -> Bool
== :: ImportLookupTableEntry -> ImportLookupTableEntry -> Bool
$c== :: ImportLookupTableEntry -> ImportLookupTableEntry -> Bool
Eq)


getImpDir :: Get ImportDirectory
getImpDir :: Get [ImportDirectoryEntry]
getImpDir = do
              ImportDirectoryEntry
entry <- Get ImportDirectoryEntry
forall t. Binary t => Get t
get
              case (ImportDirectoryEntry
entry) of
                   ImportDirectoryEntry
IDNull -> [ImportDirectoryEntry] -> Get [ImportDirectoryEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return [ImportDirectoryEntry
IDNull]
                   ImportDirectoryEntry
x      -> Get [ImportDirectoryEntry]
getImpDir Get [ImportDirectoryEntry]
-> ([ImportDirectoryEntry] -> Get [ImportDirectoryEntry])
-> Get [ImportDirectoryEntry]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[ImportDirectoryEntry]
y -> [ImportDirectoryEntry] -> Get [ImportDirectoryEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return (ImportDirectoryEntry
x ImportDirectoryEntry
-> [ImportDirectoryEntry] -> [ImportDirectoryEntry]
forall a. a -> [a] -> [a]
: [ImportDirectoryEntry]
y)


getLT :: Get ImportLookupTable
getLT :: Get [ImportLookupTableEntry]
getLT = do
           ImportLookupTableEntry
entry <- Get ImportLookupTableEntry
forall t. Binary t => Get t
get
           case (ImportLookupTableEntry
entry) of
                ImportLookupTableEntry
ILTNull -> [ImportLookupTableEntry] -> Get [ImportLookupTableEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return [ImportLookupTableEntry
ILTNull]
                ImportLookupTableEntry
x       -> Get [ImportLookupTableEntry]
getLT Get [ImportLookupTableEntry]
-> ([ImportLookupTableEntry] -> Get [ImportLookupTableEntry])
-> Get [ImportLookupTableEntry]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[ImportLookupTableEntry]
y -> [ImportLookupTableEntry] -> Get [ImportLookupTableEntry]
forall (m :: * -> *) a. Monad m => a -> m a
return (ImportLookupTableEntry
x ImportLookupTableEntry
-> [ImportLookupTableEntry] -> [ImportLookupTableEntry]
forall a. a -> [a] -> [a]
: [ImportLookupTableEntry]
y)


instance Binary HintNameEntry where
      put :: HintNameEntry -> Put
put (HNE Word16
h Filename
n) = let words' :: [Word8]
words' = ((Int -> Word8) -> [Int] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Word8]) -> [Int] -> [Word8]
forall a b. (a -> b) -> a -> b
$ (Char -> Int) -> Filename -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Int
ord Filename
n)::[Word8] in
                       do 
                        Word16 -> Put
forall t. Binary t => t -> Put
put Word16
h
                        [Word8] -> Put
forall t. Binary t => t -> Put
put [Word8]
words'
                        if ([Word8] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word8]
words' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) 
                          then Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
0x0::Word8)
                          else () -> Put
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      get :: Get HintNameEntry
get = do
               Word16
ordinal <- Get Word16
getWord16le
               Filename
astr <- Get Filename
getAStr
               if (Filename -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Filename
astr Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
2 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0)
                 then Get Word8
getWord8 Get Word8 -> (Word8 -> Get HintNameEntry) -> Get HintNameEntry
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word8
_ -> HintNameEntry -> Get HintNameEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Filename -> HintNameEntry
HNE Word16
ordinal Filename
astr)
                 else HintNameEntry -> Get HintNameEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (Word16 -> Filename -> HintNameEntry
HNE Word16
ordinal Filename
astr)

instance Binary ImportDirectoryEntry where
    put :: ImportDirectoryEntry -> Put
put (ID Word32
lut Word32
ts Word32
fc Word32
nrva Word32
iarva) = Word32 -> Put
forall t. Binary t => t -> Put
put Word32
lut Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall t. Binary t => t -> Put
put Word32
ts Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall t. Binary t => t -> Put
put Word32
fc Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall t. Binary t => t -> Put
put Word32
nrva Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall t. Binary t => t -> Put
put Word32
iarva
    put (ImportDirectoryEntry
IDNull) = Word32 -> Put
forall t. Binary t => t -> Put
put (Word32
0x0::Word32) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall t. Binary t => t -> Put
put (Word32
0x0::Word32) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall t. Binary t => t -> Put
put (Word32
0x0::Word32) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall t. Binary t => t -> Put
put (Word32
0x0::Word32) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Put
forall t. Binary t => t -> Put
put (Word32
0x0::Word32)
    get :: Get ImportDirectoryEntry
get = do
            Word32
lut <- Get Word32
getWord32le
            Word32
ts <- Get Word32
getWord32le
            Word32
fc <- Get Word32
getWord32le
            Word32
nrva <- Get Word32
getWord32le
            Word32
iarva <- Get Word32
getWord32le
            case (Word32
lut Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
ts Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
fc Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
nrva Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
iarva) of
                    Word32
0 -> ImportDirectoryEntry -> Get ImportDirectoryEntry
forall (m :: * -> *) a. Monad m => a -> m a
return ImportDirectoryEntry
IDNull
                    Word32
_ -> ImportDirectoryEntry -> Get ImportDirectoryEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
-> Word32 -> Word32 -> Word32 -> Word32 -> ImportDirectoryEntry
ID Word32
lut Word32
ts Word32
fc Word32
nrva Word32
iarva)

instance Binary ImportLookupTableEntry where
   put :: ImportLookupTableEntry -> Put
put (ILTOrd Word16
ord') = Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
0x80::Word8) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Put
forall t. Binary t => t -> Put
put Word16
ord' Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
forall t. Binary t => t -> Put
put (Word8
0x00::Word8)
   put (ILTHint Word32
rva) = Word32 -> Put
forall t. Binary t => t -> Put
put (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
setBit Word32
rva Int
31)
   put ImportLookupTableEntry
ILTNull = Word32 -> Put
forall t. Binary t => t -> Put
put (Word32
0x0::Word32)
   get :: Get ImportLookupTableEntry
get = do
            Word32
word <- Get Word32
getWord32le
            case (Word32
word) of
                Word32
0 -> ImportLookupTableEntry -> Get ImportLookupTableEntry
forall (m :: * -> *) a. Monad m => a -> m a
return ImportLookupTableEntry
ILTNull
                Word32
_ -> case (Word32 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Word32
word Int
31) of
                          Bool
True  -> ImportLookupTableEntry -> Get ImportLookupTableEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (ImportLookupTableEntry -> Get ImportLookupTableEntry)
-> ImportLookupTableEntry -> Get ImportLookupTableEntry
forall a b. (a -> b) -> a -> b
$ Word16 -> ImportLookupTableEntry
ILTOrd (Word16 -> ImportLookupTableEntry)
-> Word16 -> ImportLookupTableEntry
forall a b. (a -> b) -> a -> b
$ Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
word
                          Bool
False -> ImportLookupTableEntry -> Get ImportLookupTableEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (ImportLookupTableEntry -> Get ImportLookupTableEntry)
-> ImportLookupTableEntry -> Get ImportLookupTableEntry
forall a b. (a -> b) -> a -> b
$ Word32 -> ImportLookupTableEntry
ILTHint (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
clearBit Word32
word Int
31)
--More PE Data structure stuff
importInfo :: Filename -> [([Char], [String])]
importInfo :: Filename -> [(Filename, [Filename])]
importInfo Filename
fn = [SectionMeta] -> [DirectoryEntry] -> [(Filename, [Filename])]
importInfo' (Filename -> [SectionMeta]
getsecs Filename
fn) (Filename -> [DirectoryEntry]
getdirs Filename
fn)

importInfo' :: [SectionMeta] -> [DirectoryEntry] -> [([Char], [String])]
importInfo' :: [SectionMeta] -> [DirectoryEntry] -> [(Filename, [Filename])]
importInfo' [SectionMeta]
secns [DirectoryEntry]
dirs = (ImportDirectoryEntry -> (Filename, [Filename]))
-> [ImportDirectoryEntry] -> [(Filename, [Filename])]
forall a b. (a -> b) -> [a] -> [b]
map ImportDirectoryEntry -> (Filename, [Filename])
infos [ImportDirectoryEntry]
ientries 
                where ary :: UArray Word32 Word8
ary = [SectionMeta] -> UArray Word32 Word8
arrayrep [SectionMeta]
secns
                      ientries :: [ImportDirectoryEntry]
ientries = ImportDirectoryEntry
-> [ImportDirectoryEntry] -> [ImportDirectoryEntry]
forall a. Eq a => a -> [a] -> [a]
delete ImportDirectoryEntry
IDNull ([ImportDirectoryEntry] -> [ImportDirectoryEntry])
-> [ImportDirectoryEntry] -> [ImportDirectoryEntry]
forall a b. (a -> b) -> a -> b
$  UArray Word32 Word8 -> [DirectoryEntry] -> [ImportDirectoryEntry]
buildImport UArray Word32 Word8
ary [DirectoryEntry]
dirs
                      lookups :: ImportDirectoryEntry -> [ImportLookupTableEntry]
lookups = (UArray Word32 Word8
-> ImportDirectoryEntry -> [ImportLookupTableEntry]
buildLookup UArray Word32 Word8
ary) 
                      hnts :: ImportLookupTableEntry -> HintNameEntry
hnts = (UArray Word32 Word8 -> ImportLookupTableEntry -> HintNameEntry
buildHintName UArray Word32 Word8
ary) 
                      infos :: ImportDirectoryEntry -> (Filename, [Filename])
infos = \ImportDirectoryEntry
x -> (UArray Word32 Word8 -> ImportDirectoryEntry -> Filename
getdllname UArray Word32 Word8
ary ImportDirectoryEntry
x, (HintNameEntry -> Filename) -> [HintNameEntry] -> [Filename]
forall a b. (a -> b) -> [a] -> [b]
map HintNameEntry -> Filename
name ([HintNameEntry] -> [Filename]) -> [HintNameEntry] -> [Filename]
forall a b. (a -> b) -> a -> b
$ (ImportLookupTableEntry -> HintNameEntry)
-> [ImportLookupTableEntry] -> [HintNameEntry]
forall a b. (a -> b) -> [a] -> [b]
map ImportLookupTableEntry -> HintNameEntry
hnts ([ImportLookupTableEntry] -> [HintNameEntry])
-> [ImportLookupTableEntry] -> [HintNameEntry]
forall a b. (a -> b) -> a -> b
$ ImportLookupTableEntry
-> [ImportLookupTableEntry] -> [ImportLookupTableEntry]
forall a. Eq a => a -> [a] -> [a]
delete ImportLookupTableEntry
ILTNull ([ImportLookupTableEntry] -> [ImportLookupTableEntry])
-> [ImportLookupTableEntry] -> [ImportLookupTableEntry]
forall a b. (a -> b) -> a -> b
$ ImportDirectoryEntry -> [ImportLookupTableEntry]
lookups ImportDirectoryEntry
x)

--Build the Import table.
buildImport :: UArray Word32 Word8 -> [DirectoryEntry] -> ImportDirectory
buildImport :: UArray Word32 Word8 -> [DirectoryEntry] -> [ImportDirectoryEntry]
buildImport UArray Word32 Word8
ary [DirectoryEntry]
dirs = Get [ImportDirectoryEntry] -> ByteString -> [ImportDirectoryEntry]
forall a. Get a -> ByteString -> a
runGet Get [ImportDirectoryEntry]
getImpDir ByteString
bstr  
                where itaddr :: Word32
itaddr = DirectoryEntry -> Word32
virtualAddr ([DirectoryEntry]
dirs [DirectoryEntry] -> Int -> DirectoryEntry
forall a. [a] -> Int -> a
!! Int
1)
                      bstr :: ByteString
bstr = Int -> UArray Word32 Word8 -> ByteString
grabAt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
itaddr) UArray Word32 Word8
ary
                      
buildLookup :: UArray Word32 Word8 -> ImportDirectoryEntry -> ImportLookupTable
buildLookup :: UArray Word32 Word8
-> ImportDirectoryEntry -> [ImportLookupTableEntry]
buildLookup UArray Word32 Word8
ary ImportDirectoryEntry
ientry = Get [ImportLookupTableEntry]
-> ByteString -> [ImportLookupTableEntry]
forall a. Get a -> ByteString -> a
runGet Get [ImportLookupTableEntry]
getLT (Int -> UArray Word32 Word8 -> ByteString
grabAt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
rva) UArray Word32 Word8
ary)
                where rva :: Word32
rva = ImportDirectoryEntry -> Word32
lookupTableRVA ImportDirectoryEntry
ientry

buildHintName :: UArray Word32 Word8 -> ImportLookupTableEntry -> HintNameEntry
buildHintName :: UArray Word32 Word8 -> ImportLookupTableEntry -> HintNameEntry
buildHintName UArray Word32 Word8
ary ImportLookupTableEntry
ltentry = case (ImportLookupTableEntry
ltentry) of
                                  (ILTHint Word32
x) -> Get HintNameEntry -> ByteString -> HintNameEntry
forall a. Get a -> ByteString -> a
runGet Get HintNameEntry
hnte (Int -> UArray Word32 Word8 -> ByteString
grabAt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
x) UArray Word32 Word8
ary)
                                  (ImportLookupTableEntry
ILTNull) -> Filename -> HintNameEntry
forall a. HasCallStack => Filename -> a
error Filename
"Null encountered"
                                  ImportLookupTableEntry
_ -> Filename -> HintNameEntry
forall a. HasCallStack => Filename -> a
error Filename
"Not working with ords today"
                where hnte :: Get HintNameEntry
hnte = Get HintNameEntry
forall t. Binary t => Get t
get Get HintNameEntry
-> (HintNameEntry -> Get HintNameEntry) -> Get HintNameEntry
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \HintNameEntry
x -> HintNameEntry -> Get HintNameEntry
forall (m :: * -> *) a. Monad m => a -> m a
return HintNameEntry
x::Get HintNameEntry

getdllname :: UArray Word32 Word8 -> ImportDirectoryEntry -> [Char]
getdllname :: UArray Word32 Word8 -> ImportDirectoryEntry -> Filename
getdllname UArray Word32 Word8
ary ImportDirectoryEntry
ientry = case (ImportDirectoryEntry
ientry) of
                             (ImportDirectoryEntry
IDNull) -> Filename
""
                             ImportDirectoryEntry
_        -> Get Filename -> ByteString -> Filename
forall a. Get a -> ByteString -> a
runGet Get Filename
getAStr (Int -> UArray Word32 Word8 -> ByteString
grabAt (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
rva) UArray Word32 Word8
ary) 
                where rva :: Word32
rva = ImportDirectoryEntry -> Word32
nameRVA ImportDirectoryEntry
ientry
--Building an array to represent the file structure
sectoblist :: Num a => (SectionTable, LBS.ByteString) -> [(a, Word8)]
sectoblist :: SectionMeta -> [(a, Word8)]
sectoblist (SectionTable
secn, ByteString
bytes) = let words' :: [Word8]
words' = ByteString -> [Word8]
LBS.unpack ByteString
bytes in
                           let indxs :: t -> [t]
indxs t
x = t
x t -> [t] -> [t]
forall a. a -> [a] -> [a]
: t -> [t]
indxs (t
xt -> t -> t
forall a. Num a => a -> a -> a
+t
1) in
                            [a] -> [Word8] -> [(a, Word8)]
forall a b. [a] -> [b] -> [(a, b)]
zip (a -> [a]
forall t. Num t => t -> [t]
indxs (a -> [a]) -> a -> [a]
forall a b. (a -> b) -> a -> b
$ Word32 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> a) -> Word32 -> a
forall a b. (a -> b) -> a -> b
$ SectionTable -> Word32
virtualAddress SectionTable
secn) [Word8]
words'

arrayrep :: [SectionMeta] -> UArray Word32 Word8
arrayrep :: [SectionMeta] -> UArray Word32 Word8
arrayrep [SectionMeta]
secn = (Word32, Word32) -> [(Word32, Word8)] -> UArray Word32 Word8
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [(i, e)] -> a i e
array (Word32
0,Word32
maxaddr) [(Word32, Word8)]
words'
        where
          words' :: [(Word32, Word8)]
words' = [[(Word32, Word8)]] -> [(Word32, Word8)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Word32, Word8)]] -> [(Word32, Word8)])
-> [[(Word32, Word8)]] -> [(Word32, Word8)]
forall a b. (a -> b) -> a -> b
$ (SectionMeta -> [(Word32, Word8)])
-> [SectionMeta] -> [[(Word32, Word8)]]
forall a b. (a -> b) -> [a] -> [b]
map SectionMeta -> [(Word32, Word8)]
forall a. Num a => SectionMeta -> [(a, Word8)]
sectoblist [SectionMeta]
secn
          maxaddr :: Word32
maxaddr = [Word32] -> Word32
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Word32] -> Word32) -> [Word32] -> Word32
forall a b. (a -> b) -> a -> b
$ ((Word32, Word8) -> Word32) -> [(Word32, Word8)] -> [Word32]
forall a b. (a -> b) -> [a] -> [b]
map (Word32, Word8) -> Word32
forall a b. (a, b) -> a
fst [(Word32, Word8)]
words'

--Ask for an address to begin a new head for a bytestring to build from, simple enough.
{-
grabAt :: Word32 -> UArray Word32 Word8 -> LBS.ByteString
grabAt indx ary = LBS.pack $ elems newarray 
        where maxdx = maximum $ indices ary
              newarray = ixmap (0,maxdx-indx) (\i -> i - indx) ary --remap the array
-}
grabAt :: Int -> UArray Word32 Word8 -> LBS.ByteString
grabAt :: Int -> UArray Word32 Word8 -> ByteString
grabAt Int
indx UArray Word32 Word8
ary = [Word8] -> ByteString
LBS.pack ([Word8] -> ByteString) -> [Word8] -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> [Word8] -> [Word8]
forall a. Int -> [a] -> [a]
drop (Int
indx) ([Word8] -> [Word8]) -> [Word8] -> [Word8]
forall a b. (a -> b) -> a -> b
$ UArray Word32 Word8 -> [Word8]
forall (a :: * -> * -> *) e i. (IArray a e, Ix i) => a i e -> [e]
elems UArray Word32 Word8
ary