module Bindings.Bfd (
Bfd
, Bfd'
, FileMode
, init
, getTargetsAndFormats
, open
, close
, checkFormat
, Bindings.Bfd.getByteorder
, Bindings.Bfd.getHeaderByteorder
, getDisasm
, getFilename
, Bindings.Bfd.getFlags
, Bindings.Bfd.getObjectFlags
, Bindings.Bfd.getSectionFlags
, Bindings.Bfd.getFlavour
, getFormat
, getMachine
, getOctetsPerByte
, getSectionByName
, getSections
, getTarget
, getMyArchive
, getSymbolTable
, getDynamicSymbolTable
, getDynamicRelocations
, isBigEndian
, isLittleEndian
, isHeaderBigEndian
, isHeaderLittleEndian
, isCoffFamily
) where
import Control.Exception
import Control.Monad
import Data.Bits
import Data.Maybe
import Data.Word
import Foreign.C
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
import Prelude hiding (catch, init)
import Bindings.Bfd.Disasm
import Bindings.Bfd.Endian
import Bindings.Bfd.Exception
import Bindings.Bfd.Flags as BfdFlags
import Bindings.Bfd.Flavour
import Bindings.Bfd.Format
import Bindings.Bfd.Relocation
import Bindings.Bfd.Section as Section
import Bindings.Bfd.Section.Flags as SectionFlags
import Bindings.Bfd.SymbolTable as SymbolTable
import Bindings.Bfd.Target as Target
type FileMode = String
type Bfd = Ptr Bfd'
data Bfd' = Filename String
| XVec Target
| Format Format
| Flags Int
| Sections Section
| MyArchive Bfd
deriving (Show)
instance Storable Bfd' where
sizeOf _ = (180)
alignment = sizeOf
peekByteOff buf off
| off == ((4)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) buf :: IO CString
str <- peekCString val
return $ Filename str
| off == ((8)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) buf :: IO Word
return $ XVec $ wordPtrToPtr $ fromIntegral val
| off == ((44)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 44)) buf :: IO CUInt
return $ Format $ toEnum $ fromIntegral val
| off == ((52)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 52)) buf :: IO CUInt
return $ Bindings.Bfd.Flags $ fromIntegral val
| off == ((100)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 100)) buf
return $ Sections val
| off == ((140)) =
do
val <- ((\hsc_ptr -> peekByteOff hsc_ptr 140)) buf :: IO Bfd
return $ MyArchive val
| otherwise = error $ "internal error: Bfd.peekByteOff " ++ show off
poke _ _ = return ()
init
:: IO ()
init = c_bfd_init
getTargetsAndFormats
:: FilePath
-> IO [(TargetName, Format)]
getTargetsAndFormats file =
do
ts <- Target.list
let
perms = [ (t,f) | t <- ts, f <- enumFrom Object ]
foldM g [] perms
where
g xs r@(t,f) =
do
bfd <- open file (Just t) "r"
xvec1 <- getTarget bfd
tn1 <- Target.getName xvec1
ok <- catch (checkFormat bfd f) ((\_ -> return False) :: BfdException -> IO Bool)
case ok of
True ->
do
xvec2 <- getTarget bfd
tn2 <- Target.getName xvec2
if tn1 == tn2
then return $ r : xs
else return xs
False -> return xs
open
:: FilePath
-> Maybe TargetName
-> FileMode
-> IO Bfd
open fp targ mode =
do
fp' <- newCString fp
targ' <- newCString targ0
mode' <- newCString mode
throwExceptionIfNull "open" fp targ0 (c_bfd_fopen fp' targ' mode' (1))
where
targ0 = fromMaybe "default" targ
close
:: Bfd
-> IO Bool
close bfd =
do
r <- c_bfd_close bfd
return $ toBool r
checkFormat
:: Bfd
-> Format
-> IO Bool
checkFormat bfd format =
do
res <- c_bfd_check_format bfd format'
throwExceptionIfFalse "checkFormat" (show format) (return $ toBool res)
where
format' = fromIntegral $ fromEnum format
getByteorder
:: Bfd
-> IO Endian
getByteorder bfd =
do
xvec <- getTarget bfd
Target.getByteorder xvec
getHeaderByteorder
:: Bfd
-> IO Endian
getHeaderByteorder bfd =
do
xvec <- getTarget bfd
Target.getHeaderByteorder xvec
getDisasm
:: Bfd
-> IO Disasm
getDisasm = c_disassembler
getFilename
:: Bfd
-> IO String
getFilename bfd =
do
fn <- peekByteOff bfd ((4))
return $ unBfd'Filename fn
getFlags
:: Bfd
-> IO [BfdFlags.Flags]
getFlags bfd =
do
flags <- peekByteOff bfd ((52))
let
flags' = filter f $ enumFrom HasReloc
where
f e = unBfd'Flags flags .&. (bit $ fromEnum e) /= 0
return flags'
getObjectFlags
:: Bfd
-> IO [BfdFlags.Flags]
getObjectFlags bfd =
do
xvec <- getTarget bfd
Target.getObjectFlags xvec
getSectionFlags
:: Bfd
-> IO [SectionFlags.Flags]
getSectionFlags bfd =
do
xvec <- getTarget bfd
Target.getSectionFlags xvec
getFlavour
:: Bfd
-> IO Flavour
getFlavour bfd =
do
xvec <- getTarget bfd
Target.getFlavour xvec
getFormat
:: Bfd
-> IO Format
getFormat bfd =
do
format <- peekByteOff bfd ((44))
return $ unBfd'Format format
getMachine
:: Bfd
-> IO Int
getMachine bfd =
do
m <- c_bfd_get_mach bfd
return $ fromIntegral m
getOctetsPerByte
:: Bfd
-> IO Int
getOctetsPerByte bfd =
do
opb <- c_bfd_octets_per_byte bfd
return $ fromIntegral opb
getSectionByName
:: Bfd
-> SectionName
-> IO Section
getSectionByName bfd sn = withCString sn (\s -> c_bfd_get_section_by_name bfd s)
getSections
:: Bfd
-> IO [Section]
getSections bfd =
do
(Sections first) <- peekByteOff bfd ((100))
getSections' first []
where
getSections' sect rs
| sect == nullPtr = return $ reverse rs
| otherwise =
do
next <- getNext sect
getSections' next (sect : rs)
getTarget
:: Bfd
-> IO Target
getTarget bfd =
do
xv <- peekByteOff bfd ((8))
return $ unBfd'XVec xv
getMyArchive
:: Bfd
-> IO (Maybe Bfd)
getMyArchive bfd =
do
ma <- peekByteOff bfd ((140))
return $ case unBfd'MyArchive ma == nullPtr of
True -> Nothing
False -> Just $ unBfd'MyArchive ma
getSymbolTable
:: Bfd
-> IO SymbolTable
getSymbolTable bfd =
do
xvec <- getTarget bfd
bound <- getSymtabUpperBound xvec bfd
let
ptrs = bound `quot` (4)
pps <- mallocArray ptrs
count <- canonicalizeSymtab xvec bfd pps
return $ SymbolTable.mk pps count
getDynamicSymbolTable
:: Bfd
-> IO SymbolTable
getDynamicSymbolTable bfd =
do
xvec <- getTarget bfd
bound <- getDynamicSymtabUpperBound xvec bfd
let
ptrs = fromIntegral bound `quot` (4)
pps <- mallocArray ptrs
count <- canonicalizeDynamicSymtab xvec bfd pps
return $ SymbolTable.mk pps count
getDynamicRelocations
:: Bfd
-> SymbolTable
-> IO [Relocation]
getDynamicRelocations bfd st =
do
xvec <- getTarget bfd
bound <- getDynamicRelocUpperBound xvec bfd
let
ptrs = fromIntegral bound `quot` (4)
ppr <- mallocArray ptrs
count <- canonicalizeDynamicReloc xvec bfd ppr $ tablePtr st
prs <- peekArray count ppr
mapM peek prs
isBigEndian
:: Bfd
-> IO Bool
isBigEndian bfd =
do
bo <- Bindings.Bfd.getByteorder bfd
return $ bo == Big
isLittleEndian
:: Bfd
-> IO Bool
isLittleEndian bfd =
do
bo <- Bindings.Bfd.getByteorder bfd
return $ bo == Little
isHeaderBigEndian
:: Bfd
-> IO Bool
isHeaderBigEndian bfd =
do
bo <- Bindings.Bfd.getHeaderByteorder bfd
return $ bo == Big
isHeaderLittleEndian
:: Bfd
-> IO Bool
isHeaderLittleEndian bfd =
do
bo <- Bindings.Bfd.getHeaderByteorder bfd
return $ bo == Little
isCoffFamily
:: Bfd
-> IO Bool
isCoffFamily bfd =
do
flav <- Bindings.Bfd.getFlavour bfd
return $ flav == Coff || flav == Xcoff
unBfd'Filename
:: Bfd'
-> String
unBfd'Filename (Filename fn) = fn
unBfd'Filename _ = error "unBfd'Filename"
unBfd'XVec
:: Bfd'
-> Target
unBfd'XVec (XVec p) = p
unBfd'XVec _ = error "unBfd'XVec"
unBfd'Format
:: Bfd'
-> Format
unBfd'Format (Format f) = f
unBfd'Format _ = error "unBfd'Format"
unBfd'Flags
:: Bfd'
-> Int
unBfd'Flags (Bindings.Bfd.Flags m) = m
unBfd'Flags _ = error "unBfd'Flags"
unBfd'MyArchive
:: Bfd'
-> Bfd
unBfd'MyArchive (MyArchive ma) = ma
unBfd'MyArchive _ = error "unBfd'MyArchive"
foreign import ccall unsafe "bfd.h bfd_init" c_bfd_init
:: IO ()
foreign import ccall unsafe "bfd.h bfd_fopen" c_bfd_fopen
:: CString
-> CString
-> CString
-> CInt
-> IO Bfd
foreign import ccall unsafe "bfd.h bfd_close" c_bfd_close
:: Bfd
-> IO CInt
foreign import ccall unsafe "bfd.h bfd_check_format" c_bfd_check_format
:: Bfd
-> CInt
-> IO CInt
foreign import ccall unsafe "bfd.h bfd_get_mach" c_bfd_get_mach
:: Bfd
-> IO CInt
foreign import ccall unsafe "bfd.h bfd_octets_per_byte" c_bfd_octets_per_byte
:: Bfd
-> IO CUInt
foreign import ccall unsafe "bfd.h bfd_get_section_by_name" c_bfd_get_section_by_name
:: Bfd
-> CString
-> IO Section
foreign import ccall unsafe "dis-asm.h disassembler" c_disassembler
:: Bfd
-> IO Disasm