Updates to Haskell bindings (#667)

* [haskell] Added uc_context_* support

As per issue #662

* [haskell] Updated bindings for commit 4083b87032

Updated for introduction of UC_HOOK_MEM_READ_AFTER.

* [haskell] Style fixes
This commit is contained in:
Adrian Herrera 2016-10-30 03:51:02 +01:00 committed by Nguyen Anh Quynh
parent 4d5738eeb5
commit 19028f41f6
15 changed files with 594 additions and 410 deletions

View file

@ -9,40 +9,46 @@ framework based on QEMU.
Further information is available at <http://www.unicorn-engine.org>.
-}
module Unicorn (
-- * Emulator control
Emulator,
Engine,
Architecture(..),
Mode(..),
QueryType(..),
runEmulator,
open,
query,
start,
stop,
module Unicorn
( -- * Emulator control
Emulator
, Engine
, Architecture(..)
, Mode(..)
, QueryType(..)
, runEmulator
, open
, query
, start
, stop
-- * Register operations
regWrite,
regRead,
, regWrite
, regRead
-- * Memory operations
MemoryPermission(..),
MemoryRegion(..),
memWrite,
memRead,
memMap,
memUnmap,
memProtect,
memRegions,
, MemoryPermission(..)
, MemoryRegion(..)
, memWrite
, memRead
, memMap
, memUnmap
, memProtect
, memRegions
-- * Context operations
, Context
, contextAlloc
, contextSave
, contextRestore
-- * Error handling
Error(..),
errno,
strerror,
, Error(..)
, errno
, strerror
-- * Misc.
version,
, version
) where
import Control.Monad (liftM)
@ -132,8 +138,8 @@ stop uc = do
-------------------------------------------------------------------------------
-- | Write to register.
regWrite :: Reg r =>
Engine -- ^ 'Unicorn' engine handle
regWrite :: Reg r
=> Engine -- ^ 'Unicorn' engine handle
-> r -- ^ Register ID to write to
-> Int64 -- ^ Value to write to register
-> Emulator () -- ^ An 'Error' on failure
@ -147,8 +153,8 @@ regWrite uc regId value = do
left err
-- | Read register value.
regRead :: Reg r =>
Engine -- ^ 'Unicorn' engine handle
regRead :: Reg r
=> Engine -- ^ 'Unicorn' engine handle
-> r -- ^ Register ID to read from
-> Emulator Int64 -- ^ The value read from the register on success,
-- or an 'Error' on failure
@ -259,6 +265,46 @@ memRegions uc = do
else
left err
-------------------------------------------------------------------------------
-- Context operations
-------------------------------------------------------------------------------
-- | Allocate a region that can be used to perform quick save/rollback of the
-- CPU context, which includes registers and some internal metadata. Contexts
-- may not be shared across engine instances with differing architectures or
-- modes.
contextAlloc :: Engine -- ^ 'Unicon' engine handle
-> Emulator Context -- ^ A CPU context
contextAlloc uc = do
(err, contextPtr) <- lift $ ucContextAlloc uc
if err == ErrOk then
-- Return a CPU context if ucContextAlloc completed successfully
lift $ mkContext contextPtr
else
left err
-- | Save a copy of the internal CPU context.
contextSave :: Engine -- ^ 'Unicorn' engine handle
-> Context -- ^ A CPU context
-> Emulator () -- ^ An error on failure
contextSave uc context = do
err <- lift $ ucContextSave uc context
if err == ErrOk then
right ()
else
left err
-- | Restore the current CPU context from a saved copy.
contextRestore :: Engine -- ^ 'Unicorn' engine handle
-> Context -- ^ A CPU context
-> Emulator () -- ^ An error on failure
contextRestore uc context = do
err <- lift $ ucContextRestore uc context
if err == ErrOk then
right ()
else
left err
-------------------------------------------------------------------------------
-- Misc.
-------------------------------------------------------------------------------

View file

@ -8,8 +8,9 @@ License : GPL-2
Definitions for the ARM architecture.
-}
module Unicorn.CPU.Arm (
Register(..),
module Unicorn.CPU.Arm
(
Register(..)
) where
import Unicorn.Internal.Core (Reg)
@ -21,9 +22,11 @@ import Unicorn.Internal.Core (Reg)
-- | ARM registers.
{# enum uc_arm_reg as Register
{ underscoreToCase }
omit (UC_ARM_REG_INVALID,
UC_ARM_REG_ENDING)
omit ( UC_ARM_REG_INVALID
, UC_ARM_REG_ENDING
)
with prefix = "UC_ARM_REG_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
instance Reg Register

View file

@ -8,8 +8,9 @@ License : GPL-2
Definitions for the ARM64 (ARMv8) architecture.
-}
module Unicorn.CPU.Arm64 (
Register(..),
module Unicorn.CPU.Arm64
(
Register(..)
) where
import Unicorn.Internal.Core (Reg)
@ -21,9 +22,11 @@ import Unicorn.Internal.Core (Reg)
-- | ARM64 registers.
{# enum uc_arm64_reg as Register
{ underscoreToCase }
omit (UC_ARM64_REG_INVALID,
UC_ARM64_REG_ENDING)
omit ( UC_ARM64_REG_INVALID
, UC_ARM64_REG_ENDING
)
with prefix = "UC_ARM64_REG_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
instance Reg Register

View file

@ -8,8 +8,9 @@ License : GPL-2
Definitions for the MK68K architecture.
-}
module Unicorn.CPU.M68k (
Register(..),
module Unicorn.CPU.M68k
(
Register(..)
) where
import Unicorn.Internal.Core (Reg)
@ -21,9 +22,11 @@ import Unicorn.Internal.Core (Reg)
-- | M68K registers.
{# enum uc_m68k_reg as Register
{ underscoreToCase }
omit (UC_M68K_REG_INVALID,
UC_M68K_REG_ENDING)
omit ( UC_M68K_REG_INVALID
, UC_M68K_REG_ENDING
)
with prefix = "UC_M68K_REG_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
instance Reg Register

View file

@ -8,8 +8,9 @@ License : GPL-2
Definitions for the MIPS architecture.
-}
module Unicorn.CPU.Mips (
Register(..),
module Unicorn.CPU.Mips
(
Register(..)
) where
import Unicorn.Internal.Core (Reg)
@ -20,42 +21,45 @@ import Unicorn.Internal.Core (Reg)
-- | 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)
{ underscoreToCase
, UC_MIPS_REG_0 as Reg0g
, UC_MIPS_REG_1 as Reg1g
, UC_MIPS_REG_2 as Reg2g
, UC_MIPS_REG_3 as Reg3g
, UC_MIPS_REG_4 as Reg4g
, UC_MIPS_REG_5 as Reg5g
, UC_MIPS_REG_6 as Reg6g
, UC_MIPS_REG_7 as Reg7g
, UC_MIPS_REG_8 as Reg8g
, UC_MIPS_REG_9 as Reg9g
, UC_MIPS_REG_10 as Reg10g
, UC_MIPS_REG_11 as Reg11g
, UC_MIPS_REG_12 as Reg12g
, UC_MIPS_REG_13 as Reg13g
, UC_MIPS_REG_14 as Reg14g
, UC_MIPS_REG_15 as Reg15g
, UC_MIPS_REG_16 as Reg16g
, UC_MIPS_REG_17 as Reg17g
, UC_MIPS_REG_18 as Reg18g
, UC_MIPS_REG_19 as Reg19g
, UC_MIPS_REG_20 as Reg20g
, UC_MIPS_REG_21 as Reg21g
, UC_MIPS_REG_22 as Reg22g
, UC_MIPS_REG_23 as Reg23g
, UC_MIPS_REG_24 as Reg24g
, UC_MIPS_REG_25 as Reg25g
, UC_MIPS_REG_26 as Reg26g
, UC_MIPS_REG_27 as Reg27g
, UC_MIPS_REG_28 as Reg28g
, UC_MIPS_REG_29 as Reg29g
, UC_MIPS_REG_30 as Reg30g
, UC_MIPS_REG_31 as Reg31
}
omit ( UC_MIPS_REG_INVALID
, UC_MIPS_REG_ENDING
)
with prefix = "UC_MIPS_REG_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
instance Reg Register

View file

@ -8,8 +8,9 @@ License : GPL-2
Definitions for the SPARC architecture.
-}
module Unicorn.CPU.Sparc (
Register(..),
module Unicorn.CPU.Sparc
(
Register(..)
) where
import Unicorn.Internal.Core (Reg)
@ -21,9 +22,11 @@ import Unicorn.Internal.Core (Reg)
-- | SPARC registers.
{# enum uc_sparc_reg as Register
{ underscoreToCase }
omit (UC_SPARC_REG_INVALID,
UC_SPARC_REG_ENDING)
omit (UC_SPARC_REG_INVALID
, UC_SPARC_REG_ENDING
)
with prefix = "UC_SPARC_REG_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
instance Reg Register

View file

@ -8,10 +8,11 @@ License : GPL-2
Definitions for the X86 architecture.
-}
module Unicorn.CPU.X86 (
Mmr(..),
Register(..),
Instruction(..),
module Unicorn.CPU.X86
(
Mmr(..)
, Register(..)
, Instruction(..)
) where
import Control.Applicative
@ -26,11 +27,11 @@ import Unicorn.Internal.Core (Reg)
-- | Memory-managemen Register for instructions IDTR, GDTR, LDTR, TR.
-- Borrow from SegmentCache in qemu/target-i386/cpu.h
data Mmr = Mmr {
mmrSelector :: Word16, -- ^ Not used by GDTR and IDTR
mmrBase :: Word64, -- ^ Handle 32 or 64 bit CPUs
mmrLimit :: Word32,
mmrFlags :: Word32 -- ^ Not used by GDTR and IDTR
data Mmr = Mmr
{ mmrSelector :: Word16 -- ^ Not used by GDTR and IDTR
, mmrBase :: Word64 -- ^ Handle 32 or 64 bit CPUs
, mmrLimit :: Word32
, mmrFlags :: Word32 -- ^ Not used by GDTR and IDTR
}
instance Storable Mmr where
@ -49,17 +50,21 @@ instance Storable Mmr where
-- | X86 registers.
{# enum uc_x86_reg as Register
{ underscoreToCase }
omit (UC_X86_REG_INVALID,
UC_X86_REG_ENDING)
omit ( UC_X86_REG_INVALID
, UC_X86_REG_ENDING
)
with prefix = "UC_X86_REG_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
instance Reg Register
-- | X86 instructions.
{# enum uc_x86_insn as Instruction
{ underscoreToCase }
omit (UC_X86_INS_INVALID,
UC_X86_INS_ENDING)
omit ( UC_X86_INS_INVALID
, UC_X86_INS_ENDING
)
with prefix = "UC_X86_INS_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}

View file

@ -6,35 +6,35 @@ License : GPL-2
Insert hook points into the Unicorn emulator engine.
-}
module Unicorn.Hook (
-- * Hook types
Hook,
MemoryHookType(..),
MemoryEventHookType(..),
MemoryAccess(..),
module Unicorn.Hook
( -- * Hook types
Hook
, MemoryHookType(..)
, MemoryEventHookType(..)
, MemoryAccess(..)
-- * Hook callbacks
CodeHook,
InterruptHook,
BlockHook,
InHook,
OutHook,
SyscallHook,
MemoryHook,
MemoryReadHook,
MemoryWriteHook,
MemoryEventHook,
, CodeHook
, InterruptHook
, BlockHook
, InHook
, OutHook
, SyscallHook
, MemoryHook
, MemoryReadHook
, MemoryWriteHook
, MemoryEventHook
-- * Hook callback management
codeHookAdd,
interruptHookAdd,
blockHookAdd,
inHookAdd,
outHookAdd,
syscallHookAdd,
memoryHookAdd,
memoryEventHookAdd,
hookDel,
, codeHookAdd
, interruptHookAdd
, blockHookAdd
, inHookAdd
, outHookAdd
, syscallHookAdd
, memoryHookAdd
, memoryEventHookAdd
, hookDel
) where
import Control.Monad
@ -213,7 +213,8 @@ hookDel uc hook = do
-- 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 :: IO (Error, Hook)
-> IO (Either Error Hook)
getResult =
liftM (uncurry checkResult)
where checkResult err hook =

View file

@ -25,14 +25,16 @@ import Foreign
-- | The Unicorn engine.
{# pointer *uc_engine as Engine
foreign finalizer uc_close_wrapper as close
newtype #}
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 call 'uc_close_wrapper' when it goes out of scope.
mkEngine :: EnginePtr -> IO Engine
mkEngine :: EnginePtr
-> IO Engine
mkEngine ptr =
liftM Engine (newForeignPtr close ptr)
@ -41,7 +43,8 @@ mkEngine ptr =
{# enum uc_err as Error
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
-- | The emulator runs in the IO monad and allows for the handling of errors
-- "under the hood".

View file

@ -11,42 +11,42 @@ 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(..),
module Unicorn.Internal.Hook
( -- * Types
Hook
, HookType(..)
, MemoryHookType(..)
, MemoryEventHookType(..)
, MemoryAccess(..)
-- * Hook callback bindings
CodeHook,
InterruptHook,
BlockHook,
InHook,
OutHook,
SyscallHook,
MemoryHook,
MemoryReadHook,
MemoryWriteHook,
MemoryEventHook,
, CodeHook
, InterruptHook
, BlockHook
, InHook
, OutHook
, SyscallHook
, MemoryHook
, MemoryReadHook
, MemoryWriteHook
, MemoryEventHook
-- * Hook marshalling
marshalCodeHook,
marshalInterruptHook,
marshalBlockHook,
marshalInHook,
marshalOutHook,
marshalSyscallHook,
marshalMemoryHook,
marshalMemoryReadHook,
marshalMemoryWriteHook,
marshalMemoryEventHook,
-- * Hook marshallin
, marshalCodeHook
, marshalInterruptHook
, marshalBlockHook
, marshalInHook
, marshalOutHook
, marshalSyscallHook
, marshalMemoryHook
, marshalMemoryReadHook
, marshalMemoryWriteHook
, marshalMemoryEventHook
-- * Hook registration and deletion bindings
ucHookAdd,
ucInsnHookAdd,
ucHookDel,
, ucHookAdd
, ucInsnHookAdd
, ucHookDel
) where
import Control.Monad
@ -54,11 +54,11 @@ import Foreign
import Unicorn.Internal.Util
{# context lib="unicorn" #}
{# import Unicorn.Internal.Core #}
{# import Unicorn.CPU.X86 #}
{# context lib = "unicorn" #}
#include <unicorn/unicorn.h>
#include "unicorn_wrapper.h"
@ -79,7 +79,8 @@ import Unicorn.Internal.Util
foreign import ccall "&uc_close_dummy"
closeDummy :: FunPtr (EnginePtr -> IO ())
mkEngineNC :: EnginePtr -> IO Engine
mkEngineNC :: EnginePtr
-> IO Engine
mkEngineNC ptr =
liftM Engine (newForeignPtr closeDummy ptr)
@ -93,46 +94,54 @@ type Hook = {# type uc_hook #}
-- 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)
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
, UC_HOOK_MEM_READ_AFTER
)
with prefix = "UC_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
-- | 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)
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, Bounded) #}
deriving (Show, Eq, Bounded)
#}
-- | 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)
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
, UC_HOOK_MEM_READ_AFTER
)
with prefix = "UC_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
-- | Unify the hook types with a type class
class Enum a => HookTypeC a
@ -145,7 +154,8 @@ instance HookTypeC MemoryEventHookType
{# enum uc_mem_type as MemoryAccess
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
-------------------------------------------------------------------------------
-- Hook callbacks
@ -162,10 +172,12 @@ type CodeHook a = Engine -- ^ 'Unicorn' engine handle
type CCodeHook = EnginePtr -> Word64 -> Word32 -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkCodeHook :: CCodeHook -> IO {# type uc_cb_hookcode_t #}
mkCodeHook :: CCodeHook
-> IO {# type uc_cb_hookcode_t #}
marshalCodeHook :: Storable a
=> CodeHook a -> IO {# type uc_cb_hookcode_t #}
=> CodeHook a
-> IO {# type uc_cb_hookcode_t #}
marshalCodeHook codeHook =
mkCodeHook $ \ucPtr address size userDataPtr -> do
uc <- mkEngineNC ucPtr
@ -186,7 +198,8 @@ foreign import ccall "wrapper"
mkInterruptHook :: CInterruptHook -> IO {# type uc_cb_hookintr_t #}
marshalInterruptHook :: Storable a
=> InterruptHook a -> IO {# type uc_cb_hookintr_t #}
=> InterruptHook a
-> IO {# type uc_cb_hookintr_t #}
marshalInterruptHook interruptHook =
mkInterruptHook $ \ucPtr intNo userDataPtr -> do
uc <- mkEngineNC ucPtr
@ -197,7 +210,8 @@ marshalInterruptHook interruptHook =
type BlockHook a = CodeHook a
marshalBlockHook :: Storable a
=> BlockHook a -> IO {# type uc_cb_hookcode_t #}
=> BlockHook a
-> IO {# type uc_cb_hookcode_t #}
marshalBlockHook =
marshalCodeHook
@ -214,7 +228,8 @@ 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 #}
=> InHook a
-> IO {# type uc_cb_insn_in_t #}
marshalInHook inHook =
mkInHook $ \ucPtr port size userDataPtr -> do
uc <- mkEngineNC ucPtr
@ -232,10 +247,12 @@ type OutHook a = Engine -- ^ 'Unicorn' engine handle
type COutHook = EnginePtr -> Word32 -> Int32 -> Word32 -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkOutHook :: COutHook -> IO {# type uc_cb_insn_out_t #}
mkOutHook :: COutHook
-> IO {# type uc_cb_insn_out_t #}
marshalOutHook :: Storable a
=> OutHook a -> IO {# type uc_cb_insn_out_t #}
=> OutHook a
-> IO {# type uc_cb_insn_out_t #}
marshalOutHook outHook =
mkOutHook $ \ucPtr port size value userDataPtr -> do
uc <- mkEngineNC ucPtr
@ -251,10 +268,12 @@ type SyscallHook a = Engine -- ^ 'Unicorn' engine handle
type CSyscallHook = Ptr () -> Ptr () -> IO ()
foreign import ccall "wrapper"
mkSyscallHook :: CSyscallHook -> IO {# type uc_cb_insn_syscall_t #}
mkSyscallHook :: CSyscallHook
-> IO {# type uc_cb_insn_syscall_t #}
marshalSyscallHook :: Storable a
=> SyscallHook a -> IO {# type uc_cb_insn_syscall_t #}
=> SyscallHook a
-> IO {# type uc_cb_insn_syscall_t #}
marshalSyscallHook syscallHook =
mkSyscallHook $ \ucPtr userDataPtr -> do
uc <- mkEngineNC $ castPtr ucPtr
@ -281,10 +300,12 @@ type CMemoryHook = EnginePtr
-> IO ()
foreign import ccall "wrapper"
mkMemoryHook :: CMemoryHook -> IO {# type uc_cb_hookmem_t #}
mkMemoryHook :: CMemoryHook
-> IO {# type uc_cb_hookmem_t #}
marshalMemoryHook :: Storable a
=> MemoryHook a -> IO {# type uc_cb_hookmem_t #}
=> MemoryHook a
-> IO {# type uc_cb_hookmem_t #}
marshalMemoryHook memoryHook =
mkMemoryHook $ \ucPtr memAccessI address size value userDataPtr -> do
uc <- mkEngineNC ucPtr
@ -304,7 +325,8 @@ type MemoryReadHook a = Engine -- ^ 'Unicorn' engine handle
-> IO ()
marshalMemoryReadHook :: Storable a
=> MemoryReadHook a -> IO {# type uc_cb_hookmem_t #}
=> MemoryReadHook a
-> IO {# type uc_cb_hookmem_t #}
marshalMemoryReadHook memoryReadHook =
mkMemoryHook $ \ucPtr _ address size _ userDataPtr -> do
uc <- mkEngineNC ucPtr
@ -321,7 +343,8 @@ type MemoryWriteHook a = Engine -- ^ 'Unicorn' engine handle
-> IO ()
marshalMemoryWriteHook :: Storable a
=> MemoryWriteHook a -> IO {# type uc_cb_hookmem_t #}
=> MemoryWriteHook a
-> IO {# type uc_cb_hookmem_t #}
marshalMemoryWriteHook memoryWriteHook =
mkMemoryHook $ \ucPtr _ address size value userDataPtr -> do
uc <- mkEngineNC ucPtr
@ -351,10 +374,12 @@ type CMemoryEventHook = EnginePtr
-> IO Int32
foreign import ccall "wrapper"
mkMemoryEventHook :: CMemoryEventHook -> IO {# type uc_cb_eventmem_t #}
mkMemoryEventHook :: CMemoryEventHook
-> IO {# type uc_cb_eventmem_t #}
marshalMemoryEventHook :: Storable a
=> MemoryEventHook a -> IO {# type uc_cb_eventmem_t #}
=> MemoryEventHook a
-> IO {# type uc_cb_eventmem_t #}
marshalMemoryEventHook eventMemoryHook =
mkMemoryEventHook $ \ucPtr memAccessI address size value userDataPtr -> do
uc <- mkEngineNC ucPtr
@ -378,38 +403,43 @@ marshalMemoryEventHook eventMemoryHook =
-------------------------------------------------------------------------------
{# 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' #}
`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' #}
`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' #}
{ `Engine'
, fromIntegral `Hook'
} -> `Error'
#}
-------------------------------------------------------------------------------
-- Helper functions
-------------------------------------------------------------------------------
toMemAccess :: Integral a => a -> MemoryAccess
toMemAccess :: Integral a
=> a
-> MemoryAccess
toMemAccess =
toEnum . fromIntegral

View file

@ -12,33 +12,39 @@ 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(..),
module Unicorn.Internal.Unicorn
( -- * Types
Architecture(..)
, Mode(..)
, MemoryPermission(..)
, MemoryRegion(..)
, QueryType(..)
, Context
-- * Function bindings
ucOpen,
ucQuery,
ucEmuStart,
ucEmuStop,
ucRegWrite,
ucRegRead,
ucMemWrite,
ucMemRead,
ucMemMap,
ucMemUnmap,
ucMemProtect,
ucMemRegions,
ucVersion,
ucErrno,
ucStrerror,
, ucOpen
, ucQuery
, ucEmuStart
, ucEmuStop
, ucRegWrite
, ucRegRead
, ucMemWrite
, ucMemRead
, ucMemMap
, ucMemUnmap
, ucMemProtect
, ucMemRegions
, mkContext
, ucContextAlloc
, ucContextSave
, ucContextRestore
, ucVersion
, ucErrno
, ucStrerror
) where
import Control.Applicative
import Control.Monad
import Data.ByteString (ByteString, useAsCStringLen)
import Foreign
import Foreign.C
@ -46,11 +52,12 @@ import Prelude hiding (until)
import Unicorn.Internal.Util
{# context lib="unicorn" #}
{# import Unicorn.Internal.Core #}
{# context lib = "unicorn" #}
#include <unicorn/unicorn.h>
#include "unicorn_wrapper.h"
-------------------------------------------------------------------------------
-- Types
@ -60,26 +67,30 @@ import Unicorn.Internal.Util
{# enum uc_arch as Architecture
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
-- | CPU hardware mode.
{# enum uc_mode as Mode
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
-- | Memory permissions.
{# enum uc_prot as MemoryPermission
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
-- | Memory region mapped by 'memMap'. Retrieve the list of memory regions with
-- 'memRegions'.
data MemoryRegion = MemoryRegion {
mrBegin :: Word64, -- ^ Begin address of the region (inclusive)
mrEnd :: Word64, -- ^ End address of the region (inclusive)
mrPerms :: [MemoryPermission] -- ^ Memory permissions of the region
data MemoryRegion = MemoryRegion
{
mrBegin :: Word64 -- ^ Begin address of the region (inclusive)
, mrEnd :: Word64 -- ^ End address of the region (inclusive)
, mrPerms :: [MemoryPermission] -- ^ Memory permissions of the region
}
instance Storable MemoryRegion where
@ -101,35 +112,55 @@ instance Storable MemoryRegion where
{# enum uc_query_type as QueryType
{ underscoreToCase }
with prefix = "UC_"
deriving (Show, Eq, Bounded) #}
deriving (Show, Eq, Bounded)
#}
-- | Opaque storage for CPU context, used with the context functions.
{# pointer *uc_context as Context
foreign finalizer uc_context_free_wrapper as contextFree
newtype
#}
-- | A pointer to a CPU context.
{# pointer *uc_context as ContextPtr -> Context #}
-- | Make a CPU context out of a context pointer. The returned CPU context will
-- automatically call 'uc_context_free' when it goes out of scope.
mkContext :: ContextPtr
-> IO Context
mkContext ptr =
liftM Context (newForeignPtr contextFree ptr)
-------------------------------------------------------------------------------
-- Emulator control
-------------------------------------------------------------------------------
{# fun uc_open as ^
{`Architecture',
combineEnums `[Mode]',
alloca- `EnginePtr' peek*}
-> `Error' #}
{ `Architecture'
, combineEnums `[Mode]'
, alloca- `EnginePtr' peek*
} -> `Error'
#}
{# fun uc_query as ^
{`Engine',
`QueryType',
alloca- `Int' castPtrAndPeek*}
-> `Error' #}
{ `Engine'
, `QueryType'
, alloca- `Int' castPtrAndPeek*
} -> `Error'
#}
{# fun uc_emu_start as ^
{`Engine',
`Word64',
`Word64',
`Int',
`Int'}
-> `Error' #}
{ `Engine'
, `Word64'
, `Word64'
, `Int'
, `Int'} -> `Error'
#}
{# fun uc_emu_stop as ^
{`Engine'}
-> `Error' #}
{ `Engine'
} -> `Error'
#}
-------------------------------------------------------------------------------
-- Register operations
@ -137,83 +168,116 @@ instance Storable MemoryRegion where
{# fun uc_reg_write as ^
`Reg r' =>
{`Engine',
enumToNum `r',
castPtr `Ptr Int64'}
-> `Error' #}
{ `Engine'
, enumToNum `r'
, castPtr `Ptr Int64'
} -> `Error'
#}
{# fun uc_reg_read as ^
`Reg r' =>
{`Engine',
enumToNum `r',
allocaInt64ToVoid- `Int64' castPtrAndPeek*}
-> `Error' #}
{ `Engine'
, enumToNum `r'
, allocaInt64ToVoid- `Int64' castPtrAndPeek*
} -> `Error'
#}
-------------------------------------------------------------------------------
-- Memory operations
-------------------------------------------------------------------------------
{# fun uc_mem_write as ^
{`Engine',
`Word64',
withByteStringLen* `ByteString'&}
-> `Error' #}
{ `Engine'
, `Word64'
, withByteStringLen* `ByteString'&
} -> `Error'
#}
{# fun uc_mem_read as ^
{`Engine',
`Word64',
castPtr `Ptr Word8',
`Int'}
-> `Error' #}
{ `Engine'
, `Word64'
, castPtr `Ptr Word8'
, `Int'} -> `Error'
#}
{# fun uc_mem_map as ^
{`Engine',
`Word64',
`Int',
combineEnums `[MemoryPermission]'}
-> `Error' #}
{ `Engine'
, `Word64'
, `Int'
, combineEnums `[MemoryPermission]'
} -> `Error' #}
{# fun uc_mem_unmap as ^
{`Engine',
`Word64',
`Int'}
-> `Error' #}
{ `Engine'
, `Word64'
, `Int'
} -> `Error'
#}
{# fun uc_mem_protect as ^
{`Engine',
`Word64',
`Int',
combineEnums `[MemoryPermission]'}
-> `Error' #}
{ `Engine'
, `Word64'
, `Int'
, combineEnums `[MemoryPermission]'
} -> `Error'
#}
{# fun uc_mem_regions as ^
{`Engine',
alloca- `MemoryRegionPtr' peek*,
alloca- `Int' castPtrAndPeek*}
-> `Error' #}
{ `Engine'
, alloca- `MemoryRegionPtr' peek*
, alloca- `Int' castPtrAndPeek*
} -> `Error'
#}
-------------------------------------------------------------------------------
-- Context
-------------------------------------------------------------------------------
{# fun uc_context_alloc as ^
{ `Engine'
, alloca- `ContextPtr' peek*
} -> `Error'
#}
{# fun uc_context_save as ^
{ `Engine'
, `Context'
} -> `Error'
#}
{# fun uc_context_restore as ^
{ `Engine'
, `Context'
} -> `Error'
#}
-------------------------------------------------------------------------------
-- Misc.
-------------------------------------------------------------------------------
{# fun pure unsafe uc_version as ^
{id `Ptr CUInt',
id `Ptr CUInt'}
-> `Int' #}
{ id `Ptr CUInt'
, id `Ptr CUInt'
} -> `Int'
#}
{# fun unsafe uc_errno as ^
{`Engine'}
-> `Error' #}
{ `Engine'
} -> `Error'
#}
{# fun pure unsafe uc_strerror as ^
{`Error'}
-> `String' #}
{ `Error'
} -> `String'
#}
-------------------------------------------------------------------------------
-- Helper functions
-------------------------------------------------------------------------------
expandMemPerms :: (Integral a, Bits a) => a -> [MemoryPermission]
expandMemPerms :: (Integral a, Bits a)
=> a
-> [MemoryPermission]
expandMemPerms perms =
-- Only interested in the 3 least-significant bits
let maskedPerms = fromIntegral $ perms .&. 0x7 in
@ -232,10 +296,13 @@ expandMemPerms perms =
checkRWE _ [] =
[]
allocaInt64ToVoid :: (Ptr () -> IO b) -> IO b
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 :: ByteString
-> ((Ptr (), CULong) -> IO a)
-> IO a
withByteStringLen bs f =
useAsCStringLen bs $ \(ptr, len) -> f (castPtr ptr, fromIntegral len)

View file

@ -10,16 +10,22 @@ 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 :: (Enum a, Num b, Bits b)
=> [a]
-> b
combineEnums =
foldr ((.|.) <$> enumToNum) 0
-- | Cast a pointer and then peek inside it.
castPtrAndPeek :: Storable a => Ptr b -> IO a
castPtrAndPeek :: Storable a
=> Ptr b
-> IO a
castPtrAndPeek =
peek . castPtr
-- | Convert an 'Eum' to a 'Num'.
enumToNum :: (Enum a, Num b) => a -> b
enumToNum :: (Enum a, Num b)
=> a
-> b
enumToNum =
fromIntegral . fromEnum

View file

@ -6,3 +6,7 @@ void uc_close_wrapper(uc_engine *uc) {
void uc_close_dummy(uc_engine *uc) {
}
void uc_context_free_wrapper(uc_context *context) {
uc_context_free(context);
}

View file

@ -13,4 +13,9 @@ void uc_close_wrapper(uc_engine *uc);
*/
void uc_close_dummy(uc_engine *uc);
/*
* Wrap Unicorn's uc_context_free function and ignore the returned error code.
*/
void uc_context_free_wrapper(uc_context *context);
#endif

View file

@ -14,7 +14,8 @@ category: System
build-type: Simple
stability: experimental
cabal-version: >= 1.10
extra-source-files: cbits/, include/
extra-source-files: cbits/
, include/
library
exposed-modules: Unicorn.Internal.Core
@ -29,10 +30,10 @@ library
Unicorn.Hook
Unicorn
other-modules: Unicorn.Internal.Util
build-depends: base >=4 && <5,
bytestring >= 0.9.1,
transformers < 0.6,
either >= 4.4
build-depends: base >=4 && <5
, bytestring >= 0.9.1
, transformers < 0.6
, either >= 4.4
hs-source-dirs: src
c-sources: src/cbits/unicorn_wrapper.c
include-dirs: src/include