bindings-bfd-0.2.0: src/Bindings/Bfd.hsc
-- This file is part of Bindings-bfd.
--
-- Copyright (C) 2010 Michael Nelson
--
-- Bindings-bfd is free software: you can redistribute it and/or modify
-- it under the terms of the GNU Lesser General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.
--
-- Bindings-bfd is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-- GNU Lesser General Public License for more details.
-- You should have received a copy of the GNU Lesser General Public License
-- along with Bindings-bfd. If not, see <http://www.gnu.org/licenses/>.
module Bindings.Bfd (
-- * Types
Bfd
, Bfd'
, FileMode
-- * Functions
-- ** Initialization
, init
-- ** Files
, getTargetsAndFormats
, open
, close
-- ** Format
, checkFormat
-- ** Foo
, Bindings.Bfd.getByteorder
, Bindings.Bfd.getHeaderByteorder
, getDisasm
, getFilename
, Bindings.Bfd.getFlags
, Bindings.Bfd.getObjectFlags
, Bindings.Bfd.getSectionFlags
, Bindings.Bfd.getFlavour
, getFormat
, getMachine
, getOctetsPerByte
-- *** Sections
, getSectionByName
, getSections
-- *** Target
, getTarget
-- *** Foo
, getMyArchive
-- *** Symbols
, getSymbolTable
, getDynamicSymbolTable
#if 0
, getSyntheticSymbolTable
#endif
-- *** Relocations
, getDynamicRelocations
-- ** Testing
, 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
#include <bfd.h>
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 _ = #size struct bfd
alignment = sizeOf
peekByteOff buf off
| off == (#offset struct bfd, filename) =
do
val <- (#peek struct bfd, filename) buf :: IO CString
str <- peekCString val
return $ Filename str
| off == (#offset struct bfd, xvec) =
do
val <- (#peek struct bfd, xvec) buf :: IO Word
return $ XVec $ wordPtrToPtr $ fromIntegral val
| off == (#offset struct bfd, format) =
do
val <- (#peek struct bfd, format) buf :: IO CUInt
return $ Format $ toEnum $ fromIntegral val
| off == (#offset struct bfd, flags) =
do
val <- (#peek struct bfd, flags) buf :: IO CUInt
return $ Bindings.Bfd.Flags $ fromIntegral val
| off == (#offset struct bfd, sections) =
do
val <- (#peek struct bfd, sections) buf
return $ Sections val
| off == (#offset struct bfd, my_archive) =
do
val <- (#peek struct bfd, my_archive) buf :: IO Bfd
return $ MyArchive val
| otherwise = error $ "internal error: Bfd.peekByteOff " ++ show off
poke _ _ = return ()
init
:: IO ()
-- ^ Initialize the library. Call 'init' before making any other calls.
init = c_bfd_init
getTargetsAndFormats
:: FilePath -- ^ The file to query
-> IO [(TargetName, Format)]
-- ^ Returns a 'List' of tuples representing the possible combinations of
-- 'TargetName' and 'Format' valid for this 'FilePath'.
--
-- Possible Exceptions: Same as 'open'.
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 -- ^ File to open
-> Maybe TargetName -- ^ Target
-> FileMode
-> IO Bfd
-- ^ Opens a file with the given target and mode
-- and returns a bfd object on success. If the target is 'Nothing' then
-- the file is opened with the default target.
--
-- Possible exceptions: 'NoMemory' (if any allocation fails), 'SystemCall'
-- (if open failed), and 'InvalidTarget' (if supplied target is not supported).
--
-- /Note:/ 'open' does not validate that the supplied 'TargetName' is appropriate
-- for the supplied file.
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 (#offset struct bfd, filename)
return $ unBfd'Filename fn
getFlags
:: Bfd
-> IO [BfdFlags.Flags]
getFlags bfd =
do
flags <- peekByteOff bfd (#offset struct bfd, flags)
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 (#offset struct bfd, format)
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 (#offset struct bfd, sections)
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 (#offset struct bfd, xvec)
return $ unBfd'XVec xv
getMyArchive
:: Bfd
-> IO (Maybe Bfd)
getMyArchive bfd =
do
ma <- peekByteOff bfd (#offset struct bfd, my_archive)
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` (#const sizeof(struct bfd_symbol *))
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` (#const sizeof(struct bfd_symbol *))
pps <- mallocArray ptrs
count <- canonicalizeDynamicSymtab xvec bfd pps
return $ SymbolTable.mk pps count
#if 0
getSyntheticSymbolTable
:: Bfd
-> SymbolTable -- static
-> SymbolTable -- dynamic
-> IO SymbolTable
getSyntheticSymbolTable bfd sst dst =
do
xvec <- getTarget bfd
ssyms <- malloc
count <- getSyntheticSymtab xvec bfd sst dst ssyms
return $ SymbolTable.mk ssyms count
#endif
getDynamicRelocations
:: Bfd
-> SymbolTable
-> IO [Relocation]
getDynamicRelocations bfd st =
do
xvec <- getTarget bfd
bound <- getDynamicRelocUpperBound xvec bfd
let
ptrs = fromIntegral bound `quot` (#const sizeof(arelent *))
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"
#if 0
createSections
:: Bfd
-> IO [(Section, Vma)]
createSections bfd =
do
sects <- getSections bfd
extSect <- Section.mk "externs" 5
(_, sectList) <- foldM f (0,[]) $ sects ++ [extSect]
return $ reverse sectList
where
f (vma,xs') sect =
do
(vma',snvma) <- createSection sect vma
return (vma', snvma : xs')
demangle
:: Bfd
-> String
-> IO String
demangle bfd str =
do
s <- withCString str (\s -> c_bfd_demangle bfd s 3)
case s == nullPtr of
True -> return ""
False ->
do
s' <- peekCString s
return s'
#endif
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
#if 0
foreign import ccall unsafe "bfd.h bfd_demangle" c_bfd_demangle
:: Bfd
-> CString
-> CInt
-> IO CString
#endif
foreign import ccall unsafe "dis-asm.h disassembler" c_disassembler
:: Bfd
-> IO Disasm