module Hapstone.Internal.Capstone
(
Csh
, CsArch(..)
, CsSupport(..)
, CsMode(..)
, CsOption(..)
, CsOptionState(..)
, CsOperand(..)
, CsGroup(..)
, CsSkipdataCallback
, CsSkipdataStruct(..)
, csSetSkipdata
, ArchInfo(..)
, CsDetail(..)
, peekDetail
, CsInsn(..)
, peekArch
, peekArrayArch
, csInsnOffset
, CsErr(..)
, csSupport
, csOpen
, csClose
, csOption
, csErrno
, csStrerror
, csDisasm
, csDisasmIter
, csFree
, csMalloc
, csRegName
, csInsnName
, csGroupName
, csInsnGroup
, csRegRead
, csRegWrite
, csOpCount
, csOpIndex
) where
import qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp
import qualified System.IO.Unsafe as C2HSImp
import Control.Monad (join, (>=>))
import Foreign
import Foreign.C.Types
import Foreign.C.String ( CString, peekCString
, newCString, castCharToCChar, castCCharToChar)
import Foreign.Marshal.Array (peekArray, pokeArray)
import Foreign.Ptr
import Hapstone.Internal.Util
import qualified Hapstone.Internal.Arm64 as Arm64
import qualified Hapstone.Internal.Arm as Arm
import qualified Hapstone.Internal.M68K as M68K
import qualified Hapstone.Internal.Mips as Mips
import qualified Hapstone.Internal.Ppc as Ppc
import qualified Hapstone.Internal.Sparc as Sparc
import qualified Hapstone.Internal.SystemZ as SystemZ
import qualified Hapstone.Internal.X86 as X86
import qualified Hapstone.Internal.XCore as XCore
import System.IO.Unsafe (unsafePerformIO)
type Csh = CSize
data CsArch = CsArchArm
| CsArchArm64
| CsArchMips
| CsArchX86
| CsArchPpc
| CsArchSparc
| CsArchSysz
| CsArchXcore
| CsArchM68k
| CsArchMax
| CsArchAll
deriving (Show,Eq,Bounded)
instance Enum CsArch where
succ CsArchArm = CsArchArm64
succ CsArchArm64 = CsArchMips
succ CsArchMips = CsArchX86
succ CsArchX86 = CsArchPpc
succ CsArchPpc = CsArchSparc
succ CsArchSparc = CsArchSysz
succ CsArchSysz = CsArchXcore
succ CsArchXcore = CsArchM68k
succ CsArchM68k = CsArchMax
succ CsArchMax = CsArchAll
succ CsArchAll = error "CsArch.succ: CsArchAll has no successor"
pred CsArchArm64 = CsArchArm
pred CsArchMips = CsArchArm64
pred CsArchX86 = CsArchMips
pred CsArchPpc = CsArchX86
pred CsArchSparc = CsArchPpc
pred CsArchSysz = CsArchSparc
pred CsArchXcore = CsArchSysz
pred CsArchM68k = CsArchXcore
pred CsArchMax = CsArchM68k
pred CsArchAll = CsArchMax
pred CsArchArm = error "CsArch.pred: CsArchArm has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from CsArchAll
fromEnum CsArchArm = 0
fromEnum CsArchArm64 = 1
fromEnum CsArchMips = 2
fromEnum CsArchX86 = 3
fromEnum CsArchPpc = 4
fromEnum CsArchSparc = 5
fromEnum CsArchSysz = 6
fromEnum CsArchXcore = 7
fromEnum CsArchM68k = 8
fromEnum CsArchMax = 9
fromEnum CsArchAll = 65535
toEnum 0 = CsArchArm
toEnum 1 = CsArchArm64
toEnum 2 = CsArchMips
toEnum 3 = CsArchX86
toEnum 4 = CsArchPpc
toEnum 5 = CsArchSparc
toEnum 6 = CsArchSysz
toEnum 7 = CsArchXcore
toEnum 8 = CsArchM68k
toEnum 9 = CsArchMax
toEnum 65535 = CsArchAll
toEnum unmatched = error ("CsArch.toEnum: Cannot match " ++ show unmatched)
data CsSupport = CsSupportDiet
| CsSupportX86Reduce
deriving (Show,Eq,Bounded)
instance Enum CsSupport where
succ CsSupportDiet = CsSupportX86Reduce
succ CsSupportX86Reduce = error "CsSupport.succ: CsSupportX86Reduce has no successor"
pred CsSupportX86Reduce = CsSupportDiet
pred CsSupportDiet = error "CsSupport.pred: CsSupportDiet has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from CsSupportX86Reduce
fromEnum CsSupportDiet = 65536
fromEnum CsSupportX86Reduce = 65537
toEnum 65536 = CsSupportDiet
toEnum 65537 = CsSupportX86Reduce
toEnum unmatched = error ("CsSupport.toEnum: Cannot match " ++ show unmatched)
data CsMode = CsModeLittleEndian
| CsModeArm
| CsMode16
| CsModeM68k000
| CsMode32
| CsModeM68k010
| CsModeMips32
| CsMode64
| CsModeM68k020
| CsModeMips64
| CsModeThumb
| CsModeMicro
| CsModeV9
| CsModeQpx
| CsModeM68k030
| CsModeMclass
| CsModeMips3
| CsModeM68k040
| CsModeV8
| CsModeMips32r6
| CsModeM68k060
| CsModeBigEndian
deriving (Show,Eq,Bounded)
instance Enum CsMode where
succ CsModeLittleEndian = CsMode16
succ CsModeArm = CsMode16
succ CsMode16 = CsMode32
succ CsModeM68k000 = CsMode32
succ CsMode32 = CsMode64
succ CsModeM68k010 = CsMode64
succ CsModeMips32 = CsMode64
succ CsMode64 = CsModeThumb
succ CsModeM68k020 = CsModeThumb
succ CsModeMips64 = CsModeThumb
succ CsModeThumb = CsModeMclass
succ CsModeMicro = CsModeMclass
succ CsModeV9 = CsModeMclass
succ CsModeQpx = CsModeMclass
succ CsModeM68k030 = CsModeMclass
succ CsModeMclass = CsModeV8
succ CsModeMips3 = CsModeV8
succ CsModeM68k040 = CsModeV8
succ CsModeV8 = CsModeBigEndian
succ CsModeMips32r6 = CsModeBigEndian
succ CsModeM68k060 = CsModeBigEndian
succ CsModeBigEndian = error "CsMode.succ: CsModeBigEndian has no successor"
pred CsMode16 = CsModeLittleEndian
pred CsModeM68k000 = CsModeLittleEndian
pred CsMode32 = CsMode16
pred CsModeM68k010 = CsMode16
pred CsModeMips32 = CsMode16
pred CsMode64 = CsMode32
pred CsModeM68k020 = CsMode32
pred CsModeMips64 = CsMode32
pred CsModeThumb = CsMode64
pred CsModeMicro = CsMode64
pred CsModeV9 = CsMode64
pred CsModeQpx = CsMode64
pred CsModeM68k030 = CsMode64
pred CsModeMclass = CsModeThumb
pred CsModeMips3 = CsModeThumb
pred CsModeM68k040 = CsModeThumb
pred CsModeV8 = CsModeMclass
pred CsModeMips32r6 = CsModeMclass
pred CsModeM68k060 = CsModeMclass
pred CsModeBigEndian = CsModeV8
pred CsModeLittleEndian = error "CsMode.pred: CsModeLittleEndian has no predecessor"
pred CsModeArm = error "CsMode.pred: CsModeArm has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from CsModeBigEndian
fromEnum CsModeLittleEndian = 0
fromEnum CsModeArm = 0
fromEnum CsMode16 = 2
fromEnum CsModeM68k000 = 2
fromEnum CsMode32 = 4
fromEnum CsModeM68k010 = 4
fromEnum CsModeMips32 = 4
fromEnum CsMode64 = 8
fromEnum CsModeM68k020 = 8
fromEnum CsModeMips64 = 8
fromEnum CsModeThumb = 16
fromEnum CsModeMicro = 16
fromEnum CsModeV9 = 16
fromEnum CsModeQpx = 16
fromEnum CsModeM68k030 = 16
fromEnum CsModeMclass = 32
fromEnum CsModeMips3 = 32
fromEnum CsModeM68k040 = 32
fromEnum CsModeV8 = 64
fromEnum CsModeMips32r6 = 64
fromEnum CsModeM68k060 = 64
fromEnum CsModeBigEndian = 2147483648
toEnum 0 = CsModeLittleEndian
toEnum 2 = CsMode16
toEnum 4 = CsMode32
toEnum 8 = CsMode64
toEnum 16 = CsModeThumb
toEnum 32 = CsModeMclass
toEnum 64 = CsModeV8
toEnum 2147483648 = CsModeBigEndian
toEnum unmatched = error ("CsMode.toEnum: Cannot match " ++ show unmatched)
data CsOption = CsOptSyntax
| CsOptDetail
| CsOptMode
| CsOptMem
| CsOptSkipdata
| CsOptSkipdataSetup
| CsOptMnemonic
| CsOptUnsigned
deriving (Show,Eq,Bounded)
instance Enum CsOption where
succ CsOptSyntax = CsOptDetail
succ CsOptDetail = CsOptMode
succ CsOptMode = CsOptMem
succ CsOptMem = CsOptSkipdata
succ CsOptSkipdata = CsOptSkipdataSetup
succ CsOptSkipdataSetup = CsOptMnemonic
succ CsOptMnemonic = CsOptUnsigned
succ CsOptUnsigned = error "CsOption.succ: CsOptUnsigned has no successor"
pred CsOptDetail = CsOptSyntax
pred CsOptMode = CsOptDetail
pred CsOptMem = CsOptMode
pred CsOptSkipdata = CsOptMem
pred CsOptSkipdataSetup = CsOptSkipdata
pred CsOptMnemonic = CsOptSkipdataSetup
pred CsOptUnsigned = CsOptMnemonic
pred CsOptSyntax = error "CsOption.pred: CsOptSyntax has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from CsOptUnsigned
fromEnum CsOptSyntax = 1
fromEnum CsOptDetail = 2
fromEnum CsOptMode = 3
fromEnum CsOptMem = 4
fromEnum CsOptSkipdata = 5
fromEnum CsOptSkipdataSetup = 6
fromEnum CsOptMnemonic = 7
fromEnum CsOptUnsigned = 8
toEnum 1 = CsOptSyntax
toEnum 2 = CsOptDetail
toEnum 3 = CsOptMode
toEnum 4 = CsOptMem
toEnum 5 = CsOptSkipdata
toEnum 6 = CsOptSkipdataSetup
toEnum 7 = CsOptMnemonic
toEnum 8 = CsOptUnsigned
toEnum unmatched = error ("CsOption.toEnum: Cannot match " ++ show unmatched)
data CsOptionState = CsOptOff
| CsOptSyntaxDefault
| CsOptSyntaxIntel
| CsOptSyntaxAtt
| CsOptOn
| CsOptSyntaxNoregname
| CsOptSyntaxMasm
deriving (Show,Eq,Bounded)
instance Enum CsOptionState where
succ CsOptOff = CsOptSyntaxIntel
succ CsOptSyntaxDefault = CsOptSyntaxIntel
succ CsOptSyntaxIntel = CsOptSyntaxAtt
succ CsOptSyntaxAtt = CsOptOn
succ CsOptOn = CsOptSyntaxMasm
succ CsOptSyntaxNoregname = CsOptSyntaxMasm
succ CsOptSyntaxMasm = error "CsOptionState.succ: CsOptSyntaxMasm has no successor"
pred CsOptSyntaxIntel = CsOptOff
pred CsOptSyntaxAtt = CsOptSyntaxIntel
pred CsOptOn = CsOptSyntaxAtt
pred CsOptSyntaxNoregname = CsOptSyntaxAtt
pred CsOptSyntaxMasm = CsOptOn
pred CsOptOff = error "CsOptionState.pred: CsOptOff has no predecessor"
pred CsOptSyntaxDefault = error "CsOptionState.pred: CsOptSyntaxDefault has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from CsOptSyntaxMasm
fromEnum CsOptOff = 0
fromEnum CsOptSyntaxDefault = 0
fromEnum CsOptSyntaxIntel = 1
fromEnum CsOptSyntaxAtt = 2
fromEnum CsOptOn = 3
fromEnum CsOptSyntaxNoregname = 3
fromEnum CsOptSyntaxMasm = 4
toEnum 0 = CsOptOff
toEnum 1 = CsOptSyntaxIntel
toEnum 2 = CsOptSyntaxAtt
toEnum 3 = CsOptOn
toEnum 4 = CsOptSyntaxMasm
toEnum unmatched = error ("CsOptionState.toEnum: Cannot match " ++ show unmatched)
data CsOperand = CsOpInvalid
| CsOpReg
| CsOpImm
| CsOpMem
| CsOpFp
deriving (Show,Eq,Bounded)
instance Enum CsOperand where
succ CsOpInvalid = CsOpReg
succ CsOpReg = CsOpImm
succ CsOpImm = CsOpMem
succ CsOpMem = CsOpFp
succ CsOpFp = error "CsOperand.succ: CsOpFp has no successor"
pred CsOpReg = CsOpInvalid
pred CsOpImm = CsOpReg
pred CsOpMem = CsOpImm
pred CsOpFp = CsOpMem
pred CsOpInvalid = error "CsOperand.pred: CsOpInvalid has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from CsOpFp
fromEnum CsOpInvalid = 0
fromEnum CsOpReg = 1
fromEnum CsOpImm = 2
fromEnum CsOpMem = 3
fromEnum CsOpFp = 4
toEnum 0 = CsOpInvalid
toEnum 1 = CsOpReg
toEnum 2 = CsOpImm
toEnum 3 = CsOpMem
toEnum 4 = CsOpFp
toEnum unmatched = error ("CsOperand.toEnum: Cannot match " ++ show unmatched)
data CsGroup = CsGrpInvalid
| CsGrpJump
| CsGrpCall
| CsGrpRet
| CsGrpInt
| CsGrpIret
| CsGrpPrivilege
deriving (Show,Eq,Bounded)
instance Enum CsGroup where
succ CsGrpInvalid = CsGrpJump
succ CsGrpJump = CsGrpCall
succ CsGrpCall = CsGrpRet
succ CsGrpRet = CsGrpInt
succ CsGrpInt = CsGrpIret
succ CsGrpIret = CsGrpPrivilege
succ CsGrpPrivilege = error "CsGroup.succ: CsGrpPrivilege has no successor"
pred CsGrpJump = CsGrpInvalid
pred CsGrpCall = CsGrpJump
pred CsGrpRet = CsGrpCall
pred CsGrpInt = CsGrpRet
pred CsGrpIret = CsGrpInt
pred CsGrpPrivilege = CsGrpIret
pred CsGrpInvalid = error "CsGroup.pred: CsGrpInvalid has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from CsGrpPrivilege
fromEnum CsGrpInvalid = 0
fromEnum CsGrpJump = 1
fromEnum CsGrpCall = 2
fromEnum CsGrpRet = 3
fromEnum CsGrpInt = 4
fromEnum CsGrpIret = 5
fromEnum CsGrpPrivilege = 6
toEnum 0 = CsGrpInvalid
toEnum 1 = CsGrpJump
toEnum 2 = CsGrpCall
toEnum 3 = CsGrpRet
toEnum 4 = CsGrpInt
toEnum 5 = CsGrpIret
toEnum 6 = CsGrpPrivilege
toEnum unmatched = error ("CsGroup.toEnum: Cannot match " ++ show unmatched)
type CsSkipdataCallback =
FunPtr (Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize)
data CsSkipdataStruct = CsSkipdataStruct String CsSkipdataCallback (Ptr ())
deriving (Show, Eq)
instance Storable CsSkipdataStruct where
sizeOf _ = 24
alignment _ = 8
peek p = CsSkipdataStruct
<$> (peekCString =<< (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO (C2HSImp.Ptr C2HSImp.CChar)}) p)
<*> (castFunPtr <$> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO (C2HSImp.FunPtr ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong))))))}) p)
<*> (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO (C2HSImp.Ptr ())}) p
poke p (CsSkipdataStruct s c d) = do
newCString s >>= (\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: (C2HSImp.Ptr C2HSImp.CChar))}) p
(\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: (C2HSImp.FunPtr ((C2HSImp.Ptr C2HSImp.CUChar) -> (C2HSImp.CULong -> (C2HSImp.CULong -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CULong)))))))}) p (castFunPtr c)
(\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: (C2HSImp.Ptr ()))}) p d
csSetSkipdata :: Csh -> Maybe CsSkipdataStruct -> IO CsErr
csSetSkipdata h Nothing = csOption h CsOptSkipdata CsOptOff
csSetSkipdata h (Just s) = do
csOption h CsOptSkipdata CsOptOn
with s (csOption h CsOptSkipdataSetup . fromIntegral . ptrToWordPtr)
data ArchInfo
= X86 X86.CsX86
| Arm64 Arm64.CsArm64
| Arm Arm.CsArm
| Mips Mips.CsMips
| Ppc Ppc.CsPpc
| Sparc Sparc.CsSparc
| SysZ SystemZ.CsSysZ
| XCore XCore.CsXCore
deriving (Show, Eq)
data CsDetail = CsDetail
{ regsRead :: [Word16]
, regsWrite :: [Word16]
, groups :: [Word8]
, archInfo :: Maybe ArchInfo
} deriving (Show, Eq)
instance Storable CsDetail where
sizeOf _ = 1560
alignment _ = 8
peek p = CsDetail
<$> do num <- fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 24 :: IO C2HSImp.CUChar}) p
let ptr = plusPtr p (0)
peekArray num ptr
<*> do num <- fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 66 :: IO C2HSImp.CUChar}) p
let ptr = plusPtr p (26)
peekArray num ptr
<*> do num <- fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 75 :: IO C2HSImp.CUChar}) p
let ptr = plusPtr p (67)
peekArray num ptr
<*> pure Nothing
poke p (CsDetail rR rW g a) = do
(\ptr val -> do {C2HSImp.pokeByteOff ptr 24 (val :: C2HSImp.CUChar)}) p (fromIntegral $ length rR)
if length rR > 12
then error "regs_read overflew 12 bytes"
else pokeArray (plusPtr p (0)) rR
(\ptr val -> do {C2HSImp.pokeByteOff ptr 66 (val :: C2HSImp.CUChar)}) p (fromIntegral $ length rW)
if length rW > 20
then error "regs_write overflew 20 bytes"
else pokeArray (plusPtr p (26)) rW
(\ptr val -> do {C2HSImp.pokeByteOff ptr 75 (val :: C2HSImp.CUChar)}) p (fromIntegral $ length g)
if length g > 8
then error "groups overflew 8 bytes"
else pokeArray (plusPtr p (67)) g
let bP = plusPtr p ((75) + 1)
case a of
Just (X86 x) -> poke bP x
Just (Arm64 x) -> poke bP x
Just (Arm x) -> poke bP x
Just (Mips x) -> poke bP x
Just (Ppc x) -> poke bP x
Just (Sparc x) -> poke bP x
Just (SysZ x) -> poke bP x
Just (XCore x) -> poke bP x
Nothing -> return ()
peekDetail :: CsArch -> Ptr CsDetail -> IO CsDetail
peekDetail arch p = do
detail <- peek p
let bP = plusPtr p 48
aI <- case arch of
CsArchX86 -> X86 <$> peek bP
CsArchArm64 -> Arm64 <$> peek bP
CsArchArm -> Arm <$> peek bP
CsArchMips -> Mips <$> peek bP
CsArchPpc -> Ppc <$> peek bP
CsArchSparc -> Sparc <$> peek bP
CsArchSysz -> SysZ <$> peek bP
CsArchXcore -> XCore <$> peek bP
return detail { archInfo = Just aI }
data CsInsn = CsInsn
{ insnId :: Word32
, address :: Word64
, bytes :: [Word8]
, mnemonic :: String
, opStr :: String
, detail :: Maybe CsDetail
} deriving (Show, Eq)
instance Storable CsInsn where
sizeOf _ = 240
alignment _ = 8
peek p = CsInsn
<$> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 0 :: IO C2HSImp.CUInt}) p)
<*> (fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CULong}) p)
<*> do num <- fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 16 :: IO C2HSImp.CUShort}) p
let ptr = plusPtr p (18)
peekArray num ptr
<*> ((map castCCharToChar . takeWhile (/=0)) <$>
peekArray 32 (plusPtr p (34)))
<*> ((map castCCharToChar . takeWhile (/=0)) <$>
peekArray 160 (plusPtr p (66)))
<*> return Nothing
poke p (CsInsn i a b m o d) = do
(\ptr val -> do {C2HSImp.pokeByteOff ptr 0 (val :: C2HSImp.CUInt)}) p (fromIntegral i)
(\ptr val -> do {C2HSImp.pokeByteOff ptr 8 (val :: C2HSImp.CULong)}) p (fromIntegral a)
(\ptr val -> do {C2HSImp.pokeByteOff ptr 16 (val :: C2HSImp.CUShort)}) p (fromIntegral $ length b)
if length b > 16
then error "bytes overflew 16 bytes"
else pokeArray (plusPtr p (18)) b
if length m >= 32
then error "mnemonic overflew 32 bytes"
else do pokeArray (plusPtr p (34))
(map castCharToCChar m)
poke (plusPtr p ((34) + length m))
(0 :: Word8)
if length o >= 160
then error "op_str overflew 160 bytes"
else do pokeArray (plusPtr p (66))
(map castCharToCChar o)
poke (plusPtr p ((66) + length o))
(0 :: Word8)
case d of
Nothing -> (\ptr val -> do {C2HSImp.pokeByteOff ptr 232 (val :: (C2HSImp.Ptr ()))}) p nullPtr
Just d' -> do csDetailPtr <- malloc
poke csDetailPtr d'
(\ptr val -> do {C2HSImp.pokeByteOff ptr 232 (val :: (C2HSImp.Ptr ()))}) p (castPtr csDetailPtr)
peekArch :: CsArch -> Ptr CsInsn -> IO CsInsn
peekArch arch p = do
insn <- peek p
bP <- castPtr <$> (\ptr -> do {C2HSImp.peekByteOff ptr 232 :: IO (C2HSImp.Ptr ())}) p
if bP /= nullPtr
then do
det <- peekDetail arch bP
return insn { detail = Just det }
else return insn
peekElemOffArch :: CsArch -> Ptr CsInsn -> Int -> IO CsInsn
peekElemOffArch arch ptr off =
peekArch arch (plusPtr ptr (off * sizeOf (undefined :: CsInsn)))
peekArrayArch :: CsArch -> Int -> Ptr CsInsn -> IO [CsInsn]
peekArrayArch arch num ptr
| num <= 0 = return []
| otherwise = f (num1) []
where
f 0 acc = do e <- peekElemOffArch arch ptr 0; return (e:acc)
f n acc = do e <- peekElemOffArch arch ptr n; f (n1) (e:acc)
csInsnOffset :: Ptr CsInsn -> Int -> Int
csInsnOffset p n = unsafePerformIO $
() <$> getAddr (plusPtr p (n * 240)) <*> getAddr p
where getAddr p = fromIntegral <$> (\ptr -> do {C2HSImp.peekByteOff ptr 8 :: IO C2HSImp.CULong}) p
data CsErr = CsErrOk
| CsErrMem
| CsErrArch
| CsErrHandle
| CsErrCsh
| CsErrMode
| CsErrOption
| CsErrDetail
| CsErrMemsetup
| CsErrVersion
| CsErrDiet
| CsErrSkipdata
| CsErrX86Att
| CsErrX86Intel
| CsErrX86Masm
deriving (Show,Eq,Bounded)
instance Enum CsErr where
succ CsErrOk = CsErrMem
succ CsErrMem = CsErrArch
succ CsErrArch = CsErrHandle
succ CsErrHandle = CsErrCsh
succ CsErrCsh = CsErrMode
succ CsErrMode = CsErrOption
succ CsErrOption = CsErrDetail
succ CsErrDetail = CsErrMemsetup
succ CsErrMemsetup = CsErrVersion
succ CsErrVersion = CsErrDiet
succ CsErrDiet = CsErrSkipdata
succ CsErrSkipdata = CsErrX86Att
succ CsErrX86Att = CsErrX86Intel
succ CsErrX86Intel = CsErrX86Masm
succ CsErrX86Masm = error "CsErr.succ: CsErrX86Masm has no successor"
pred CsErrMem = CsErrOk
pred CsErrArch = CsErrMem
pred CsErrHandle = CsErrArch
pred CsErrCsh = CsErrHandle
pred CsErrMode = CsErrCsh
pred CsErrOption = CsErrMode
pred CsErrDetail = CsErrOption
pred CsErrMemsetup = CsErrDetail
pred CsErrVersion = CsErrMemsetup
pred CsErrDiet = CsErrVersion
pred CsErrSkipdata = CsErrDiet
pred CsErrX86Att = CsErrSkipdata
pred CsErrX86Intel = CsErrX86Att
pred CsErrX86Masm = CsErrX86Intel
pred CsErrOk = error "CsErr.pred: CsErrOk has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from CsErrX86Masm
fromEnum CsErrOk = 0
fromEnum CsErrMem = 1
fromEnum CsErrArch = 2
fromEnum CsErrHandle = 3
fromEnum CsErrCsh = 4
fromEnum CsErrMode = 5
fromEnum CsErrOption = 6
fromEnum CsErrDetail = 7
fromEnum CsErrMemsetup = 8
fromEnum CsErrVersion = 9
fromEnum CsErrDiet = 10
fromEnum CsErrSkipdata = 11
fromEnum CsErrX86Att = 12
fromEnum CsErrX86Intel = 13
fromEnum CsErrX86Masm = 14
toEnum 0 = CsErrOk
toEnum 1 = CsErrMem
toEnum 2 = CsErrArch
toEnum 3 = CsErrHandle
toEnum 4 = CsErrCsh
toEnum 5 = CsErrMode
toEnum 6 = CsErrOption
toEnum 7 = CsErrDetail
toEnum 8 = CsErrMemsetup
toEnum 9 = CsErrVersion
toEnum 10 = CsErrDiet
toEnum 11 = CsErrSkipdata
toEnum 12 = CsErrX86Att
toEnum 13 = CsErrX86Intel
toEnum 14 = CsErrX86Masm
toEnum unmatched = error ("CsErr.toEnum: Cannot match " ++ show unmatched)
csVersion :: ((Int), (Int), (Int))
csVersion =
C2HSImp.unsafePerformIO $
alloca $ \a1' ->
alloca $ \a2' ->
csVersion'_ a1' a2' >>= \res ->
let {res' = fromIntegral res} in
peekNum a1'>>= \a1'' ->
peekNum a2'>>= \a2'' ->
return (res', a1'', a2'')
foreign import ccall "capstone/capstone.h cs_support"
csSupport' :: CInt -> Bool
csSupport :: Enum a => a -> Bool
csSupport = csSupport' . fromIntegral . fromEnum
csOpen :: (CsArch) -> ([CsMode]) -> IO ((CsErr), (Csh))
csOpen a1 a2 =
let {a1' = (fromIntegral . fromEnum) a1} in
let {a2' = combine a2} in
alloca $ \a3' ->
csOpen'_ a1' a2' a3' >>= \res ->
let {res' = (toEnum . fromIntegral) res} in
peek a3'>>= \a3'' ->
return (res', a3'')
csClose' :: (Ptr Csh) -> IO ((CsErr))
csClose' a1 =
let {a1' = id a1} in
csClose''_ a1' >>= \res ->
let {res' = (toEnum . fromIntegral) res} in
return (res')
csClose :: Csh -> IO CsErr
csClose = new >=> csClose'
csOption :: Enum a => (Csh) -> (CsOption) -> (a) -> IO ((CsErr))
csOption a1 a2 a3 =
let {a1' = id a1} in
let {a2' = (fromIntegral . fromEnum) a2} in
let {a3' = getCULongFromEnum a3} in
csOption'_ a1' a2' a3' >>= \res ->
let {res' = (toEnum . fromIntegral) res} in
return (res')
csErrno :: (Csh) -> IO ((CsErr))
csErrno a1 =
let {a1' = id a1} in
csErrno'_ a1' >>= \res ->
let {res' = (toEnum . fromIntegral) res} in
return (res')
csStrerror :: (CsErr) -> (String)
csStrerror a1 =
C2HSImp.unsafePerformIO $
let {a1' = (fromIntegral . fromEnum) a1} in
csStrerror'_ a1' >>= \res ->
C2HSImp.peekCString res >>= \res' ->
return (res')
foreign import ccall "capstone/capstone.h cs_disasm"
csDisasm' :: Csh
-> Ptr CUChar -> CSize
-> CULong
-> CSize
-> Ptr (Ptr CsInsn)
-> IO CSize
csDisasm :: CsArch -> Csh -> [Word8] -> Word64 -> Int -> IO [CsInsn]
csDisasm arch handle bytes addr num = do
array <- newArray $ map fromIntegral bytes
passedPtr <- malloc :: IO (Ptr (Ptr CsInsn))
resNum <- fromIntegral <$> csDisasm' handle array
(fromIntegral $ length bytes) (fromIntegral addr)
(fromIntegral num) passedPtr
resPtr <- peek passedPtr
free passedPtr
res <- peekArrayArch arch resNum resPtr
csFree resPtr resNum
return res
csFree :: (Ptr CsInsn) -> (Int) -> IO ()
csFree a1 a2 =
let {a1' = castPtr a1} in
let {a2' = fromIntegral a2} in
csFree'_ a1' a2' >>
return ()
csMalloc :: (Csh) -> IO ((Ptr CsInsn))
csMalloc a1 =
let {a1' = id a1} in
csMalloc'_ a1' >>= \res ->
let {res' = castPtr res} in
return (res')
foreign import ccall "capstone/capstone.h cs_disasm_iter"
csDisasmIter' :: Csh
-> Ptr (Ptr CUChar) -> Ptr CSize
-> Ptr CULong
-> Ptr CsInsn
-> IO Bool
csDisasmIter :: Csh -> [Word8] -> Word64
-> IO ([Word8], Word64, Either CsErr CsInsn)
csDisasmIter handle bytes addr = do
array <- newArray (map fromIntegral bytes) :: IO (Ptr CUChar)
arrayPtr <- new array
sizePtr <- new . fromIntegral $ length bytes
addrPtr <- new $ fromIntegral addr
insnPtr <- csMalloc handle
success <- csDisasmIter' handle arrayPtr sizePtr addrPtr insnPtr
bytes' <- join $
peekArray <$> (fromIntegral <$> peek sizePtr) <*> peek arrayPtr
addr' <- peek addrPtr
free arrayPtr
free sizePtr
free addrPtr
result <- if success
then Right <$> peek insnPtr
else Left <$> csErrno handle
return (map fromIntegral bytes', fromIntegral addr', result)
csRegName' :: (Csh) -> (Int) -> (CString)
csRegName' a1 a2 =
C2HSImp.unsafePerformIO $
let {a1' = id a1} in
let {a2' = fromIntegral a2} in
csRegName''_ a1' a2' >>= \res ->
return res >>= \res' ->
return (res')
csRegName :: Enum e => Csh -> e -> Maybe String
csRegName h = stringLookup . csRegName' h . fromEnum
csInsnName' :: (Csh) -> (Int) -> (CString)
csInsnName' a1 a2 =
C2HSImp.unsafePerformIO $
let {a1' = id a1} in
let {a2' = fromIntegral a2} in
csInsnName''_ a1' a2' >>= \res ->
return res >>= \res' ->
return (res')
csInsnName :: Enum e => Csh -> e -> Maybe String
csInsnName h = stringLookup . csInsnName' h . fromEnum
csGroupName' :: (Csh) -> (Int) -> (CString)
csGroupName' a1 a2 =
C2HSImp.unsafePerformIO $
let {a1' = id a1} in
let {a2' = fromIntegral a2} in
csGroupName''_ a1' a2' >>= \res ->
return res >>= \res' ->
return (res')
csGroupName :: Enum e => Csh -> e -> Maybe String
csGroupName h = stringLookup . csGroupName' h . fromEnum
foreign import ccall "capstone/capstone.h cs_insn_group"
csInsnGroup' :: Csh -> Ptr CsInsn -> IO Bool
csInsnGroup :: Csh -> CsInsn -> Bool
csInsnGroup h i = unsafePerformIO . withCast i $ csInsnGroup' h
foreign import ccall "capstone/capstone.h cs_reg_read"
csRegRead' :: Csh -> Ptr CsInsn -> CUInt -> IO Bool
csRegRead :: Csh -> CsInsn -> Int -> Bool
csRegRead h i =
unsafePerformIO . withCast i . flip (csRegRead' h) . fromIntegral
foreign import ccall "capstone/capstone.h cs_reg_write"
csRegWrite' :: Csh -> Ptr CsInsn -> CUInt -> IO Bool
csRegWrite :: Csh -> CsInsn -> Int -> Bool
csRegWrite h i =
unsafePerformIO . withCast i . flip (csRegWrite' h) . fromIntegral
csOpCount :: (Csh) -> (CsInsn) -> (Int) -> (Int)
csOpCount a1 a2 a3 =
C2HSImp.unsafePerformIO $
let {a1' = id a1} in
withCast a2 $ \a2' ->
let {a3' = fromIntegral a3} in
csOpCount'_ a1' a2' a3' >>= \res ->
let {res' = fromIntegral res} in
return (res')
csOpIndex :: (Csh) -> (CsInsn) -> (Int) -> (Int) -> (Int)
csOpIndex a1 a2 a3 a4 =
C2HSImp.unsafePerformIO $
let {a1' = id a1} in
withCast a2 $ \a2' ->
let {a3' = fromIntegral a3} in
let {a4' = fromIntegral a4} in
csOpIndex'_ a1' a2' a3' a4' >>= \res ->
let {res' = fromIntegral res} in
return (res')
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_version"
csVersion'_ :: ((C2HSImp.Ptr C2HSImp.CInt) -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CUInt)))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_open"
csOpen'_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr Csh) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_close"
csClose''_ :: ((C2HSImp.Ptr Csh) -> (IO C2HSImp.CInt))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_option"
csOption'_ :: (Csh -> (C2HSImp.CInt -> (C2HSImp.CULong -> (IO C2HSImp.CInt))))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_errno"
csErrno'_ :: (Csh -> (IO C2HSImp.CInt))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_strerror"
csStrerror'_ :: (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar)))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_free"
csFree'_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CULong -> (IO ())))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_malloc"
csMalloc'_ :: (Csh -> (IO (C2HSImp.Ptr ())))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_reg_name"
csRegName''_ :: (Csh -> (C2HSImp.CUInt -> (IO (C2HSImp.Ptr C2HSImp.CChar))))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_insn_name"
csInsnName''_ :: (Csh -> (C2HSImp.CUInt -> (IO (C2HSImp.Ptr C2HSImp.CChar))))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_group_name"
csGroupName''_ :: (Csh -> (C2HSImp.CUInt -> (IO (C2HSImp.Ptr C2HSImp.CChar))))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_op_count"
csOpCount'_ :: (Csh -> ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "Hapstone/Internal/Capstone.chs.h cs_op_index"
csOpIndex'_ :: (Csh -> ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (C2HSImp.CUInt -> (IO C2HSImp.CInt)))))