lazymio/unicorn
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Haskell bindings

Browse Source 
These Haskell bindings make large use of c2hs to generate much of the code, so
Unicorn's const_generator is not used.

The emulator is based on the Either monad transformer. The IO monad is used to
run the underlying Unicorn library, while the Either monad is used to handle
errors.

Instructions on how to build the bindings are located in
bindings/haskell/README.TXT. The same samples found in samples/ can be found
in bindings/haskell/samples. They should produce the same output, with slight
differences in their error handling and messaging.
This commit is contained in:
Adrian Herrera
2016-04-06 09:21:36 +10:00
parent affe94d5fe
commit 74aaf3b321
28 changed files with 2994 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
bindings/haskell/src/Unicorn/CPU/Arm.chs Normal file
View File

@@ -0,0 +1,29 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-|
Module : Unicorn.CPU.Arm
Description : Definitions for the ARM architecture.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
Definitions for the ARM architecture.
-}
module Unicorn.CPU.Arm (
Register(..),
) where
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
#include <unicorn/arm.h>
-- | ARM registers.
{# enum uc_arm_reg as Register
{underscoreToCase}
omit (UC_ARM_REG_INVALID,
UC_ARM_REG_ENDING)
with prefix="UC_ARM_REG_"
deriving (Show, Eq) #}
instance Reg Register

29
bindings/haskell/src/Unicorn/CPU/Arm64.chs Normal file
View File

@@ -0,0 +1,29 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-|
Module : Unicorn.CPU.Arm64
Description : Definitions for the ARM64 (ARMv8) architecture.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
Definitions for the ARM64 (ARMv8) architecture.
-}
module Unicorn.CPU.Arm64 (
Register(..),
) where
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
#include <unicorn/arm64.h>
-- | ARM64 registers.
{# enum uc_arm64_reg as Register
{underscoreToCase}
omit (UC_ARM64_REG_INVALID,
UC_ARM64_REG_ENDING)
with prefix="UC_ARM64_REG_"
deriving (Show, Eq) #}
instance Reg Register

29
bindings/haskell/src/Unicorn/CPU/M68k.chs Normal file
View File

@@ -0,0 +1,29 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-|
Module : Unicorn.CPU.Mk68k
Description : Definitions for the MK68K architecture.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
Definitions for the MK68K architecture.
-}
module Unicorn.CPU.M68k (
Register(..),
) where
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
#include <unicorn/m68k.h>
-- | M68K registers.
{# enum uc_m68k_reg as Register
{underscoreToCase}
omit (UC_M68K_REG_INVALID,
UC_M68K_REG_ENDING)
with prefix="UC_M68K_REG_"
deriving (Show, Eq) #}
instance Reg Register

61
bindings/haskell/src/Unicorn/CPU/Mips.chs Normal file
View File

@@ -0,0 +1,61 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-|
Module : Unicorn.CPU.Mips
Description : Definitions for the MIPS architecture.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
Definitions for the MIPS architecture.
-}
module Unicorn.CPU.Mips (
Register(..),
) where
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
#include <unicorn/mips.h>
-- | MIPS registers.
{# enum UC_MIPS_REG as Register
{underscoreToCase,
UC_MIPS_REG_0 as Reg0,
UC_MIPS_REG_1 as Reg1,
UC_MIPS_REG_2 as Reg2,
UC_MIPS_REG_3 as Reg3,
UC_MIPS_REG_4 as Reg4,
UC_MIPS_REG_5 as Reg5,
UC_MIPS_REG_6 as Reg6,
UC_MIPS_REG_7 as Reg7,
UC_MIPS_REG_8 as Reg8,
UC_MIPS_REG_9 as Reg9,
UC_MIPS_REG_10 as Reg10,
UC_MIPS_REG_11 as Reg11,
UC_MIPS_REG_12 as Reg12,
UC_MIPS_REG_13 as Reg13,
UC_MIPS_REG_14 as Reg14,
UC_MIPS_REG_15 as Reg15,
UC_MIPS_REG_16 as Reg16,
UC_MIPS_REG_17 as Reg17,
UC_MIPS_REG_18 as Reg18,
UC_MIPS_REG_19 as Reg19,
UC_MIPS_REG_20 as Reg20,
UC_MIPS_REG_21 as Reg21,
UC_MIPS_REG_22 as Reg22,
UC_MIPS_REG_23 as Reg23,
UC_MIPS_REG_24 as Reg24,
UC_MIPS_REG_25 as Reg25,
UC_MIPS_REG_26 as Reg26,
UC_MIPS_REG_27 as Reg27,
UC_MIPS_REG_28 as Reg28,
UC_MIPS_REG_29 as Reg29,
UC_MIPS_REG_30 as Reg30,
UC_MIPS_REG_31 as Reg31}
omit (UC_MIPS_REG_INVALID,
UC_MIPS_REG_ENDING)
with prefix="UC_MIPS_REG_"
deriving (Show, Eq) #}
instance Reg Register

29
bindings/haskell/src/Unicorn/CPU/Sparc.chs Normal file
View File

@@ -0,0 +1,29 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-|
Module : Unicorn.CPU.Sparc
Description : Definitions for the SPARC architecture.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
Definitions for the SPARC architecture.
-}
module Unicorn.CPU.Sparc (
Register(..),
) where
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
#include <unicorn/sparc.h>
-- | SPARC registers.
{# enum uc_sparc_reg as Register
{underscoreToCase}
omit (UC_SPARC_REG_INVALID,
UC_SPARC_REG_ENDING)
with prefix="UC_SPARC_REG_"
deriving (Show, Eq) #}
instance Reg Register

65
bindings/haskell/src/Unicorn/CPU/X86.chs Normal file
View File

@@ -0,0 +1,65 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-|
Module : Unicorn.CPU.X86
Description : Definitions for the X86 architecture.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
Definitions for the X86 architecture.
-}
module Unicorn.CPU.X86 (
Mmr(..),
Register(..),
Instruction(..),
) where
import Control.Applicative
import Data.Word
import Foreign
import Unicorn.Internal.Core (Reg)
{# context lib="unicorn" #}
#include <unicorn/x86.h>
-- | Memory-managemen Register for instructions IDTR, GDTR, LDTR, TR.
-- Borrow from SegmentCache in qemu/target-i386/cpu.h
data Mmr = Mmr {
selector :: Word16, -- ^ Not used by GDTR and IDTR
base :: Word64, -- ^ Handle 32 or 64 bit CPUs
limit :: Word32,
flags :: Word32 -- ^ Not used by GDTR and IDTR
}
instance Storable Mmr where
sizeOf _ = {# sizeof uc_x86_mmr #}
alignment _ = {# alignof uc_x86_mmr #}
peek p = Mmr <$> liftA fromIntegral ({# get uc_x86_mmr->selector #} p)
<*> liftA fromIntegral ({# get uc_x86_mmr->base #} p)
<*> liftA fromIntegral ({# get uc_x86_mmr->limit #} p)
<*> liftA fromIntegral ({# get uc_x86_mmr->flags #} p)
poke p mmr = do
{# set uc_x86_mmr.selector #} p (fromIntegral $ selector mmr)
{# set uc_x86_mmr.base #} p (fromIntegral $ base mmr)
{# set uc_x86_mmr.limit #} p (fromIntegral $ limit mmr)
{# set uc_x86_mmr.flags #} p (fromIntegral $ flags mmr)
-- | X86 registers.
{# enum uc_x86_reg as Register
{underscoreToCase}
omit (UC_X86_REG_INVALID,
UC_X86_REG_ENDING)
with prefix="UC_X86_REG_"
deriving (Show, Eq) #}
instance Reg Register
-- | X86 instructions.
{# enum uc_x86_insn as Instruction
{underscoreToCase}
omit (UC_X86_INS_INVALID,
UC_X86_INS_ENDING)
with prefix="UC_X86_INS_"
deriving (Show, Eq) #}

224
bindings/haskell/src/Unicorn/Hook.hs Normal file
View File

@@ -0,0 +1,224 @@
{-|
Module : Unicorn.Hook
Description : Unicorn hooks.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
Insert hook points into the Unicorn emulator engine.
-}
module Unicorn.Hook (
-- * Hook types
Hook,
MemoryHookType(..),
MemoryEventHookType(..),
MemoryAccess(..),
-- * Hook callbacks
CodeHook,
InterruptHook,
BlockHook,
InHook,
OutHook,
SyscallHook,
MemoryHook,
MemoryReadHook,
MemoryWriteHook,
MemoryEventHook,
-- * Hook callback management
codeHookAdd,
interruptHookAdd,
blockHookAdd,
inHookAdd,
outHookAdd,
syscallHookAdd,
memoryHookAdd,
memoryEventHookAdd,
hookDel,
) where
import Control.Monad
import Control.Monad.Trans.Class
import Control.Monad.Trans.Either (hoistEither, left, right)
import Foreign
import Unicorn.Internal.Core
import Unicorn.Internal.Hook
import Unicorn.Internal.Util
import qualified Unicorn.CPU.X86 as X86
-------------------------------------------------------------------------------
-- Hook callback management (registration and deletion)
-------------------------------------------------------------------------------
-- | Register a callback for a code hook event.
codeHookAdd :: Storable a
=> Engine -- ^ 'Unicorn' engine handle
-> CodeHook a -- ^ Code hook callback
-> a -- ^ User-defined data. This will be passed to
-- the callback function
-> Word64 -- ^ Start address
-> Word64 -- ^ End address
-> Emulator Hook -- ^ The hook handle on success, or an 'Error'
-- on failure
codeHookAdd uc callback userData begin end = do
result <- lift . alloca $ \userDataPtr -> do
poke userDataPtr userData
funPtr <- marshalCodeHook callback
getResult $ ucHookAdd uc HookCode funPtr userDataPtr begin end
hoistEither result
-- | Register a callback for an interrupt hook event.
interruptHookAdd :: Storable a
=> Engine -- ^ 'Unicorn' engine handle
-> InterruptHook a -- ^ Interrupt callback
-> a -- ^ User-defined data. This will be passed
-- to the callback function
-> Word64 -- ^ Start address
-> Word64 -- ^ End address
-> Emulator Hook -- ^ The hook handle on success, or 'Error'
-- on failure
interruptHookAdd uc callback userData begin end = do
result <- lift . alloca $ \userDataPtr -> do
poke userDataPtr userData
funPtr <- marshalInterruptHook callback
getResult $ ucHookAdd uc HookIntr funPtr userDataPtr begin end
hoistEither result
-- | Register a callback for a block hook event.
blockHookAdd :: Storable a
=> Engine -- ^ 'Unicorn' engine handle
-> BlockHook a -- ^ Block callback
-> a -- ^ User-defined data. This will be passed to
-- the callback function
-> Word64 -- ^ Start address
-> Word64 -- ^ End address
-> Emulator Hook -- ^ The hook handle on success, or an 'Error'
-- on failure
blockHookAdd uc callback userData begin end = do
result <- lift . alloca $ \userDataPtr -> do
poke userDataPtr userData
funPtr <- marshalBlockHook callback
getResult $ ucHookAdd uc HookBlock funPtr userDataPtr begin end
hoistEither result
-- | Register a callback for an IN instruction hook event (X86).
inHookAdd :: Storable a
=> Engine -- ^ 'Unicorn' engine handle
-> InHook a -- ^ IN instruction callback
-> a -- ^ User-defined data. This will be passed to the
-- callback function
-> Word64 -- ^ Start address
-> Word64 -- ^ End address
-> Emulator Hook -- ^ The hook handle on success, or an 'Error' on
-- failure
inHookAdd uc callback userData begin end = do
result <- lift . alloca $ \userDataPtr -> do
poke userDataPtr userData
funPtr <- marshalInHook callback
getResult $ ucInsnHookAdd uc HookInsn funPtr userDataPtr begin end
X86.In
hoistEither result
-- | Register a callback for an OUT instruction hook event (X86).
outHookAdd :: Storable a
=> Engine -- ^ 'Unicorn' engine handle
-> OutHook a -- ^ OUT instruction callback
-> a -- ^ User-defined data. This will be passed to the
-- callback function
-> Word64 -- ^ Start address
-> Word64 -- ^ End address
-> Emulator Hook -- ^ The hook handle on success, or an 'Error' on
-- failure
outHookAdd uc callback userData begin end = do
result <- lift . alloca $ \userDataPtr -> do
poke userDataPtr userData
funPtr <- marshalOutHook callback
getResult $ ucInsnHookAdd uc HookInsn funPtr userDataPtr begin end
X86.Out
hoistEither result
-- | Register a callback for a SYSCALL instruction hook event (X86).
syscallHookAdd :: Storable a
=> Engine -- ^ 'Unicorn' engine handle
-> SyscallHook a -- ^ SYSCALL instruction callback
-> a -- ^ User-defined data. This will be passed to
-- the callback function
-> Word64 -- ^ Start address
-> Word64 -- ^ End address
-> Emulator Hook -- ^ The hook handle on success, or an 'Error'
-- on failure
syscallHookAdd uc callback userData begin end = do
result <- lift . alloca $ \userDataPtr -> do
poke userDataPtr userData
funPtr <- marshalSyscallHook callback
getResult $ ucInsnHookAdd uc HookInsn funPtr userDataPtr begin end
X86.Syscall
hoistEither result
-- | Register a callback for a valid memory access event.
memoryHookAdd :: Storable a
=> Engine -- ^ 'Unicorn' engine handle
-> MemoryHookType -- ^ A valid memory access (e.g. read, write,
-- etc.) to trigger the callback on
-> MemoryHook a -- ^ Memory access callback
-> a -- ^ User-defined data. This will be passed to
-- the callback function
-> Word64 -- ^ Start address
-> Word64 -- ^ End address
-> Emulator Hook -- ^ The hook handle on success, or an 'Error'
-- on failure
memoryHookAdd uc memHookType callback userData begin end = do
result <- lift . alloca $ \userDataPtr -> do
poke userDataPtr userData
funPtr <- marshalMemoryHook callback
getResult $ ucHookAdd uc memHookType funPtr userDataPtr begin end
hoistEither result
-- | Register a callback for an invalid memory access event.
memoryEventHookAdd :: Storable a
=> Engine -- ^ 'Unicorn' engine handle
-> MemoryEventHookType -- ^ An invalid memory access (e.g.
-- read, write, etc.) to trigger
-- the callback on
-> MemoryEventHook a -- ^ Invalid memory access callback
-> a -- ^ User-defined data. This will
-- be passed to the callback
-- function
-> Word64 -- ^ Start address
-> Word64 -- ^ End address
-> Emulator Hook -- ^ The hook handle on success, or
-- an 'Error' on failure
memoryEventHookAdd uc memEventHookType callback userData begin end = do
result <- lift . alloca $ \userDataPtr -> do
poke userDataPtr userData
funPtr <- marshalMemoryEventHook callback
getResult $ ucHookAdd uc memEventHookType funPtr userDataPtr begin end
hoistEither result
-- | Unregister (remove) a hook callback.
hookDel :: Engine -- ^ 'Unicorn' engine handle
-> Hook -- ^ 'Hook' handle
-> Emulator () -- ^ 'ErrOk' on success, or other value on failure
hookDel uc hook = do
err <- lift $ ucHookDel uc hook
if err == ErrOk then
right ()
else
left err
-------------------------------------------------------------------------------
-- Helper functions
-------------------------------------------------------------------------------
-- Takes the tuple returned by `ucHookAdd`, an IO (Error, Hook), and
-- returns either a `Right Hook` if no error occurred or a `Left Error` if an
-- error occurred
getResult :: IO (Error, Hook) -> IO (Either Error Hook)
getResult =
liftM (uncurry checkResult)
where checkResult err hook =
if err == ErrOk then
Right hook
else
Left err

52
bindings/haskell/src/Unicorn/Internal/Core.chs Normal file
View File

@@ -0,0 +1,52 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-|
Module : Unicorn.Internal.Core
Description : Core Unicorn components.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
Defines core Unicorn components.
This module should not be directly imported; it is only exposed because of the
way cabal handles ordering of chs files.
-}
module Unicorn.Internal.Core where
import Control.Monad
import Control.Monad.Trans.Either (EitherT)
import Foreign
{# context lib="unicorn" #}
#include <unicorn/unicorn.h>
#include "unicorn_wrapper.h"
-- | The Unicorn engine.
{# pointer *uc_engine as Engine
foreign finalizer uc_close_wrapper as close
newtype #}
-- | A pointer to a Unicorn engine.
{# pointer *uc_engine as EnginePtr -> Engine #}
-- | Make a new Unicorn engine out of an engine pointer. The returned Unicorn
-- engine will automatically close 'uc_close_wrapper' when it goes out of
-- scope.
mkEngine :: EnginePtr -> IO Engine
mkEngine ptr =
liftM Engine (newForeignPtr close ptr)
-- | Errors encountered by the Unicorn API. These values are returned by
-- 'errno'.
{# enum uc_err as Error
{underscoreToCase}
with prefix = "UC_"
deriving (Show, Eq) #}
-- | The emulator runs in the IO monad and allows for the handling of errors
-- "under the hood".
type Emulator a = EitherT Error IO a
-- | An architecture-dependent register.
class Enum a => Reg a

415
bindings/haskell/src/Unicorn/Internal/Hook.chs Normal file
View File

@@ -0,0 +1,415 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-|
Module : Unicorn.Internal.Hook
Description : Unicorn hooks.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
Low-level bindings for inserting hook points into the Unicorn emulator engine.
This module should not be directly imported; it is only exposed because of the
way cabal handles ordering of chs files.
-}
module Unicorn.Internal.Hook (
-- * Types
Hook,
HookType(..),
MemoryHookType(..),
MemoryEventHookType(..),
MemoryAccess(..),
-- * Hook callback bindings
CodeHook,
InterruptHook,
BlockHook,
InHook,
OutHook,
SyscallHook,
MemoryHook,
MemoryReadHook,
MemoryWriteHook,
MemoryEventHook,
-- * Hook marshalling
marshalCodeHook,
marshalInterruptHook,
marshalBlockHook,
marshalInHook,
marshalOutHook,
marshalSyscallHook,
marshalMemoryHook,
marshalMemoryReadHook,
marshalMemoryWriteHook,
marshalMemoryEventHook,
-- * Hook registration and deletion bindings
ucHookAdd,
ucInsnHookAdd,
ucHookDel,
) where
import Control.Monad
import Foreign
import Unicorn.Internal.Util
{# context lib="unicorn" #}
{# import Unicorn.Internal.Core #}
{# import Unicorn.CPU.X86 #}
#include <unicorn/unicorn.h>
#include "unicorn_wrapper.h"
-------------------------------------------------------------------------------
-- Types
-------------------------------------------------------------------------------
-- When we pass a Unicorn engine to a hook callback, we do not want this engine
-- object to be freed automatically when the callback returns (which is what
-- would typically occur when using a ForeignPtr), because we want to continue
-- using the Unicorn engine outside the callback. To avoid this,
-- unicorn_wrapper.h provides a dummy "close" function that does nothing. When
-- we go to create a Unicorn engine to pass to a callback, we use a pointer to
-- this dummy close function as the finalizer pointer. When the callback
-- returns, the Unicorn engine remains untouched!
--
-- XX Is there a better way to do this?
foreign import ccall "&uc_close_dummy"
closeDummy :: FunPtr (EnginePtr -> IO ())
mkEngineNC :: EnginePtr -> IO Engine
mkEngineNC ptr =
liftM Engine (newForeignPtr closeDummy ptr)
-- | A Unicorn hook.
type Hook = {# type uc_hook #}
-- Hook types. These are used internally within this module by the callback
-- registration functions and are not exposed to the user.
--
-- Note that the both valid and invalid memory access hooks are omitted from
-- this enum (and are exposed to the user).
{# enum uc_hook_type as HookType
{underscoreToCase}
omit (UC_HOOK_MEM_READ_UNMAPPED,
UC_HOOK_MEM_WRITE_UNMAPPED,
UC_HOOK_MEM_FETCH_UNMAPPED,
UC_HOOK_MEM_READ_PROT,
UC_HOOK_MEM_WRITE_PROT,
UC_HOOK_MEM_FETCH_PROT,
UC_HOOK_MEM_READ,
UC_HOOK_MEM_WRITE,
UC_HOOK_MEM_FETCH)
with prefix="UC_"
deriving (Show, Eq) #}
-- | Memory hook types (for valid memory accesses).
{# enum uc_hook_type as MemoryHookType
{underscoreToCase}
omit (UC_HOOK_INTR,
UC_HOOK_INSN,
UC_HOOK_CODE,
UC_HOOK_BLOCK,
UC_HOOK_MEM_READ_UNMAPPED,
UC_HOOK_MEM_WRITE_UNMAPPED,
UC_HOOK_MEM_FETCH_UNMAPPED,
UC_HOOK_MEM_READ_PROT,
UC_HOOK_MEM_WRITE_PROT,
UC_HOOK_MEM_FETCH_PROT)
with prefix="UC_"
deriving (Show, Eq) #}
-- | Memory event hook types (for invalid memory accesses).
{# enum uc_hook_type as MemoryEventHookType
{underscoreToCase}
omit (UC_HOOK_INTR,
UC_HOOK_INSN,
UC_HOOK_CODE,
UC_HOOK_BLOCK,
UC_HOOK_MEM_READ,
UC_HOOK_MEM_WRITE,
UC_HOOK_MEM_FETCH)
with prefix="UC_"
deriving (Show, Eq) #}
-- | Unify the hook types with a type class
class Enum a => HookTypeC a
instance HookTypeC HookType
instance HookTypeC MemoryHookType
instance HookTypeC MemoryEventHookType
-- | Memory access.
{# enum uc_mem_type as MemoryAccess
{underscoreToCase}
with prefix="UC_"
deriving (Show, Eq) #}
-------------------------------------------------------------------------------
-- Hook callbacks
-------------------------------------------------------------------------------
-- | Callback function for tracing code.
type CodeHook a = Engine -- ^ 'Unicorn' engine handle
-> Word64 -- ^ Addres where the code is being executed
-> Maybe Int -- ^ Size of machine instruction(s) being
-- executed, or 'Nothing' when size is unknown
-> a -- ^ User data passed to tracing APIs
-> IO ()
type CCodeHook = EnginePtr -> Word64 -> Word32 -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkCodeHook :: CCodeHook -> IO {# type uc_cb_hookcode_t #}
marshalCodeHook :: Storable a
=> CodeHook a -> IO {# type uc_cb_hookcode_t #}
marshalCodeHook codeHook =
mkCodeHook $ \ucPtr address size userDataPtr -> do
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
let maybeSize = if size == 0 then Nothing
else Just $ fromIntegral size
codeHook uc address maybeSize userData
-- | Callback function for tracing interrupts.
type InterruptHook a = Engine -- ^ 'Unicorn' engine handle
-> Int -- ^ Interrupt number
-> a -- ^ User data passed to tracing APIs
-> IO ()
type CInterruptHook = EnginePtr -> Word32 -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkInterruptHook :: CInterruptHook -> IO {# type uc_cb_hookintr_t #}
marshalInterruptHook :: Storable a
=> InterruptHook a -> IO {# type uc_cb_hookintr_t #}
marshalInterruptHook interruptHook =
mkInterruptHook $ \ucPtr intNo userDataPtr -> do
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
interruptHook uc (fromIntegral intNo) userData
-- | Callback function for tracing blocks.
type BlockHook a = CodeHook a
marshalBlockHook :: Storable a
=> BlockHook a -> IO {# type uc_cb_hookcode_t #}
marshalBlockHook =
marshalCodeHook
-- | Callback function for tracing IN instructions (X86).
type InHook a = Engine -- ^ 'Unicorn' engine handle
-> Int -- ^ Port number
-> Int -- ^ Data size (1/2/4) to be read from this port
-> a -- ^ User data passed to tracing APIs
-> IO Word32 -- ^ The data read from the port
type CInHook = EnginePtr -> Word32 -> Int32 -> Ptr () -> IO Word32
foreign import ccall "wrapper"
mkInHook :: CInHook -> IO {# type uc_cb_insn_in_t #}
marshalInHook :: Storable a
=> InHook a -> IO {# type uc_cb_insn_in_t #}
marshalInHook inHook =
mkInHook $ \ucPtr port size userDataPtr -> do
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
inHook uc (fromIntegral port) (fromIntegral size) userData
-- | Callback function for tracing OUT instructions (X86).
type OutHook a = Engine -- ^ 'Unicorn' engine handle
-> Int -- ^ Port number
-> Int -- ^ Data size (1/2/4) to be written to this port
-> Int -- ^ Data value to be written to this port
-> a -- ^ User data passed to tracing APIs
-> IO ()
type COutHook = EnginePtr -> Word32 -> Int32 -> Word32 -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkOutHook :: COutHook -> IO {# type uc_cb_insn_out_t #}
marshalOutHook :: Storable a
=> OutHook a -> IO {# type uc_cb_insn_out_t #}
marshalOutHook outHook =
mkOutHook $ \ucPtr port size value userDataPtr -> do
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
outHook uc (fromIntegral port) (fromIntegral size) (fromIntegral value)
userData
-- | Callback function for tracing SYSCALL instructions (X86).
type SyscallHook a = Engine -- ^ 'Unicorn' engine handle
-> a -- ^ User data passed to tracing APIs
-> IO ()
type CSyscallHook = Ptr () -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkSyscallHook :: CSyscallHook -> IO {# type uc_cb_insn_syscall_t #}
marshalSyscallHook :: Storable a
=> SyscallHook a -> IO {# type uc_cb_insn_syscall_t #}
marshalSyscallHook syscallHook =
mkSyscallHook $ \ucPtr userDataPtr -> do
uc <- mkEngineNC $ castPtr ucPtr
userData <- castPtrAndPeek userDataPtr
syscallHook uc userData
-- | Callback function for hooking memory operations.
type MemoryHook a = Engine -- ^ 'Unicorn' engine handle
-> MemoryAccess -- ^ Memory access; read or write
-> Word64 -- ^ Address where the code is being
-- executed
-> Int -- ^ Size of data being read or written
-> Maybe Int -- ^ Value of data being wrriten, or
-- 'Nothing' if read
-> a -- ^ User data passed to tracing APIs
-> IO ()
type CMemoryHook = EnginePtr
-> Int32
-> Word64
-> Int32
-> Int64
-> Ptr ()
-> IO ()
foreign import ccall "wrapper"
mkMemoryHook :: CMemoryHook -> IO {# type uc_cb_hookmem_t #}
marshalMemoryHook :: Storable a
=> MemoryHook a -> IO {# type uc_cb_hookmem_t #}
marshalMemoryHook memoryHook =
mkMemoryHook $ \ucPtr memAccessI address size value userDataPtr -> do
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
let memAccess = toMemAccess memAccessI
maybeValue = case memAccess of
MemRead -> Nothing
MemWrite -> Just $ fromIntegral value
_ -> undefined -- XX Handle this?
memoryHook uc memAccess address (fromIntegral size) maybeValue userData
-- | Callback function for hooking memory reads.
type MemoryReadHook a = Engine -- ^ 'Unicorn' engine handle
-> Word64 -- ^ Address where the code is being executed
-> Int -- ^ Size of data being read
-> a -- ^ User data passed to tracing APIs
-> IO ()
marshalMemoryReadHook :: Storable a
=> MemoryReadHook a -> IO {# type uc_cb_hookmem_t #}
marshalMemoryReadHook memoryReadHook =
mkMemoryHook $ \ucPtr _ address size _ userDataPtr -> do
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
memoryReadHook uc address (fromIntegral size) userData
-- | Callback function for hooking memory writes.
type MemoryWriteHook a = Engine -- ^ 'Unicorn' engine handle
-> Word64 -- ^ Address where the code is being
-- executed
-> Int -- ^ Size of data being written
-> Int -- ^ Value of data being written
-> a -- ^ User data passed to tracing APIs
-> IO ()
marshalMemoryWriteHook :: Storable a
=> MemoryWriteHook a -> IO {# type uc_cb_hookmem_t #}
marshalMemoryWriteHook memoryWriteHook =
mkMemoryHook $ \ucPtr _ address size value userDataPtr -> do
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
memoryWriteHook uc address (fromIntegral size) (fromIntegral value)
userData
-- | Callback function for handling invalid memory access events.
type MemoryEventHook a = Engine -- ^ 'Unicorn' engine handle
-> MemoryAccess -- ^ Memory access; read or write
-> Word64 -- ^ Address where the code is being
-- executed
-> Int -- ^ Size of data being read or written
-> Maybe Int -- ^ Value of data being written, or
-- 'Nothing' if read
-> a -- ^ User data passed to tracing APIs
-> IO Bool -- ^ Return 'True' to continue, or
-- 'False' to stop the program (due to
-- invalid memory)
type CMemoryEventHook = EnginePtr
-> Int32
-> Word64
-> Int32
-> Int64
-> Ptr ()
-> IO Int32
foreign import ccall "wrapper"
mkMemoryEventHook :: CMemoryEventHook -> IO {# type uc_cb_eventmem_t #}
marshalMemoryEventHook :: Storable a
=> MemoryEventHook a -> IO {# type uc_cb_eventmem_t #}
marshalMemoryEventHook eventMemoryHook =
mkMemoryEventHook $ \ucPtr memAccessI address size value userDataPtr -> do
uc <- mkEngineNC ucPtr
userData <- castPtrAndPeek userDataPtr
let memAccess = toMemAccess memAccessI
maybeValue = case memAccess of
MemReadUnmapped -> Nothing
MemReadProt -> Nothing
MemWriteUnmapped -> Just $ fromIntegral value
MemWriteProt -> Just $ fromIntegral value
_ -> undefined -- XX Handle this?
res <- eventMemoryHook uc memAccess address (fromIntegral size)
maybeValue userData
return $ boolToInt res
where boolToInt True = 1
boolToInt False = 0
-------------------------------------------------------------------------------
-- Hook callback registration (and deletion)
-------------------------------------------------------------------------------
{# fun variadic uc_hook_add as ucHookAdd
`(Storable a, HookTypeC h)' =>
{`Engine',
alloca- `Hook' peek*,
enumToNum `h',
castFunPtrToPtr `FunPtr b',
castPtr `Ptr a',
`Word64',
`Word64'}
-> `Error' #}
{# fun variadic uc_hook_add[int] as ucInsnHookAdd
`(Storable a, HookTypeC h)' =>
{`Engine',
alloca- `Hook' peek*,
enumToNum `h',
castFunPtrToPtr `FunPtr b',
castPtr `Ptr a',
`Word64',
`Word64',
enumToNum `Instruction'}
-> `Error' #}
-- | Unregister (remove) a hook callback.
{# fun uc_hook_del as ^
{`Engine',
fromIntegral `Hook'}
-> `Error' #}
-------------------------------------------------------------------------------
-- Helper functions
-------------------------------------------------------------------------------
toMemAccess :: Integral a => a -> MemoryAccess
toMemAccess =
toEnum . fromIntegral

242
bindings/haskell/src/Unicorn/Internal/Unicorn.chs Normal file
View File

@@ -0,0 +1,242 @@
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-|
Module : Unicorn.Internal.Unicorn
Description : The Unicorn CPU emulator.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
Low-level bindings for the Unicorn CPU emulator framework.
This module should not be directly imported; it is only exposed because of the
way cabal handles ordering of chs files.
-}
module Unicorn.Internal.Unicorn (
-- * Types
Architecture(..),
Mode(..),
MemoryPermission(..),
MemoryRegion(..),
QueryType(..),
-- * Function bindings
ucOpen,
ucQuery,
ucEmuStart,
ucEmuStop,
ucRegWrite,
ucRegRead,
ucMemWrite,
ucMemRead,
ucMemMap,
ucMemUnmap,
ucMemProtect,
ucMemRegions,
ucVersion,
ucErrno,
ucStrerror,
) where
import Foreign
import Foreign.C
import Control.Applicative
import Data.ByteString (ByteString, useAsCStringLen)
import Prelude hiding (until)
import Unicorn.Internal.Util
{# context lib="unicorn" #}
{# import Unicorn.Internal.Core #}
#include <unicorn/unicorn.h>
-------------------------------------------------------------------------------
-- Types
-------------------------------------------------------------------------------
-- | CPU architecture.
{# enum uc_arch as Architecture
{underscoreToCase}
with prefix = "UC_"
deriving (Show, Eq) #}
-- | CPU hardware mode.
{# enum uc_mode as Mode
{underscoreToCase}
with prefix="UC_"
deriving (Show, Eq) #}
-- | Memory permissions.
{# enum uc_prot as MemoryPermission
{underscoreToCase}
with prefix="UC_"
deriving (Show, Eq) #}
-- | Memory region mapped by 'memMap'. Retrieve the list of memory regions with
-- 'memRegions'.
data MemoryRegion = MemoryRegion {
begin :: Word64, -- ^ Begin address of the region (inclusive)
end :: Word64, -- ^ End address of the region (inclusive)
perms :: [MemoryPermission] -- ^ Memory permissions of the region
}
instance Storable MemoryRegion where
sizeOf _ = {# sizeof uc_mem_region #}
alignment _ = {# alignof uc_mem_region #}
peek p = MemoryRegion
<$> liftA fromIntegral ({# get uc_mem_region->begin #} p)
<*> liftA fromIntegral ({# get uc_mem_region->end #} p)
<*> liftA expandMemPerms ({# get uc_mem_region->perms #} p)
poke p mr = do
{# set uc_mem_region.begin #} p (fromIntegral $ begin mr)
{# set uc_mem_region.end #} p (fromIntegral $ end mr)
{# set uc_mem_region.perms #} p (combineEnums $ perms mr)
-- | A pointer to a memory region.
{# pointer *uc_mem_region as MemoryRegionPtr -> MemoryRegion #}
-- | Query types for the 'query' API.
{# enum uc_query_type as QueryType
{underscoreToCase}
with prefix="UC_"
deriving (Show, Eq) #}
-------------------------------------------------------------------------------
-- Emulator control
-------------------------------------------------------------------------------
{# fun uc_open as ^
{`Architecture',
combineEnums `[Mode]',
alloca- `EnginePtr' peek*}
-> `Error' #}
{# fun uc_query as ^
{`Engine',
`QueryType',
alloca- `Int' castPtrAndPeek*}
-> `Error' #}
{# fun uc_emu_start as ^
{`Engine',
`Word64',
`Word64',
`Int',
`Int'}
-> `Error' #}
{# fun uc_emu_stop as ^
{`Engine'}
-> `Error' #}
-------------------------------------------------------------------------------
-- Register operations
-------------------------------------------------------------------------------
{# fun uc_reg_write as ^
`Reg r' =>
{`Engine',
enumToNum `r',
castPtr `Ptr Int64'}
-> `Error' #}
{# fun uc_reg_read as ^
`Reg r' =>
{`Engine',
enumToNum `r',
allocaInt64ToVoid- `Int64' castPtrAndPeek*}
-> `Error' #}
-------------------------------------------------------------------------------
-- Memory operations
-------------------------------------------------------------------------------
{# fun uc_mem_write as ^
{`Engine',
`Word64',
withByteStringLen* `ByteString'&}
-> `Error' #}
{# fun uc_mem_read as ^
{`Engine',
`Word64',
castPtr `Ptr Word8',
`Int'}
-> `Error' #}
{# fun uc_mem_map as ^
{`Engine',
`Word64',
`Int',
combineEnums `[MemoryPermission]'}
-> `Error' #}
{# fun uc_mem_unmap as ^
{`Engine',
`Word64',
`Int'}
-> `Error' #}
{# fun uc_mem_protect as ^
{`Engine',
`Word64',
`Int',
combineEnums `[MemoryPermission]'}
-> `Error' #}
{# fun uc_mem_regions as ^
{`Engine',
alloca- `MemoryRegionPtr' peek*,
alloca- `Int' castPtrAndPeek*}
-> `Error' #}
-------------------------------------------------------------------------------
-- Misc.
-------------------------------------------------------------------------------
{# fun pure unsafe uc_version as ^
{id `Ptr CUInt',
id `Ptr CUInt'}
-> `Int' #}
{# fun unsafe uc_errno as ^
{`Engine'}
-> `Error' #}
{# fun pure unsafe uc_strerror as ^
{`Error'}
-> `String' #}
-------------------------------------------------------------------------------
-- Helper functions
-------------------------------------------------------------------------------
expandMemPerms :: (Integral a, Bits a) => a -> [MemoryPermission]
expandMemPerms perms =
-- Only interested in the 3 least-significant bits
let maskedPerms = fromIntegral $ perms .&. 0x7 in
if maskedPerms == 0x0 then
[ProtNone]
else if maskedPerms == 0x7 then
[ProtAll]
else
checkRWE maskedPerms [ProtRead, ProtWrite, ProtExec]
where
checkRWE perms (prot:prots) =
if perms .&. (fromEnum prot) /= 0 then
prot : checkRWE perms prots
else
checkRWE perms prots
checkRWE _ [] =
[]
allocaInt64ToVoid :: (Ptr () -> IO b) -> IO b
allocaInt64ToVoid f =
alloca $ \(ptr :: Ptr Int64) -> poke ptr 0 >> f (castPtr ptr)
withByteStringLen :: ByteString -> ((Ptr (), CULong) -> IO a) -> IO a
withByteStringLen bs f =
useAsCStringLen bs $ \(ptr, len) -> f (castPtr ptr, fromIntegral len)

25
bindings/haskell/src/Unicorn/Internal/Util.hs Normal file
View File

@@ -0,0 +1,25 @@
{-|
Module : Unicorn.Internal.Util
Description : Utility (aka helper) functions for the Unicorn emulator.
Copyright : (c) Adrian Herrera, 2016
License : GPL-2
-}
module Unicorn.Internal.Util where
import Data.Bits
import Foreign
-- | Combine a list of Enums by performing a bitwise-OR.
combineEnums :: (Enum a, Num b, Bits b) => [a] -> b
combineEnums =
foldr (\p -> (.|.) (enumToNum p)) 0
-- | Cast a pointer and then peek inside it.
castPtrAndPeek :: Storable a => Ptr b -> IO a
castPtrAndPeek =
peek . castPtr
-- | Convert an 'Eum' to a 'Num'.
enumToNum :: (Enum a, Num b) => a -> b
enumToNum =
fromIntegral . fromEnum