module Hapstone.Capstone
( disasmIO
, disasmSimpleIO
, Disassembler(..)
, defaultSkipdataStruct
, defaultAction
, mkCallback
) where
import Data.Word
import Foreign
import Foreign.C.Types
import Foreign.Ptr
import Hapstone.Internal.Capstone
defaultSkipdataStruct :: CsSkipdataStruct
defaultSkipdataStruct = CsSkipdataStruct ".db" nullFunPtr nullPtr
foreign import ccall "wrapper"
allocCallback :: (Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize)
-> IO CsSkipdataCallback
mkCallback :: Storable a => (Storable a => ([Word8], [Word8]) -> a -> IO CSize)
-> IO CsSkipdataCallback
mkCallback = allocCallback . mkCallback'
mkCallback' :: Storable a
=> (Storable a => ([Word8], [Word8]) -> a -> IO CSize)
-> Ptr Word8 -> CSize -> CSize -> Ptr () -> IO CSize
mkCallback' func ptr size off user_data = do
buf <- splitAt (fromIntegral off) <$> peekArray (fromIntegral size) ptr
arg <- peek (castPtr user_data)
func buf arg
defaultAction :: Csh -> CsInsn -> IO ()
defaultAction _ _ = return ()
data Disassembler a = Disassembler
{ arch :: CsArch
, modes :: [CsMode]
, buffer :: [Word8]
, addr :: Word64
, num :: Int
, detail :: Bool
, skip :: Maybe CsSkipdataStruct
, action :: Csh -> CsInsn -> IO a
}
disasmSimpleIO :: Disassembler a -> IO (Either CsErr [CsInsn])
disasmSimpleIO = fmap (fmap (map fst)) . disasmIO
disasmIO :: Disassembler a -> IO (Either CsErr [(CsInsn, a)])
disasmIO d@Disassembler{..} = do (err, handle) <- csOpen arch modes
res <- case err of
CsErrOk -> disasmIOWithHandle handle
_ -> return $ Left err
csClose handle
return res
where disasmIOWithHandle handle = do
err <- if detail
then csOption handle CsOptDetail CsOptOn
else return CsErrOk
case err of
CsErrOk -> disasmIOWithHandleDetail handle
_ -> return $ Left err
disasmIOWithHandleDetail handle = do
err <- csSetSkipdata handle skip
case err of
CsErrOk -> do insns <- csDisasm arch handle buffer addr num
as <- mapM (action handle) insns
return . Right $ zip insns as
_ -> return $ Left err