diff --git a/bindings/haskell/src/Unicorn.hs b/bindings/haskell/src/Unicorn.hs index 7f05eca4..c45a5198 100644 --- a/bindings/haskell/src/Unicorn.hs +++ b/bindings/haskell/src/Unicorn.hs @@ -9,41 +9,47 @@ framework based on QEMU. Further information is available at . -} -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, + -- * Register operations + , regWrite + , regRead - -- * Memory operations - MemoryPermission(..), - MemoryRegion(..), - memWrite, - memRead, - memMap, - memUnmap, - memProtect, - memRegions, + -- * Memory operations + , MemoryPermission(..) + , MemoryRegion(..) + , memWrite + , memRead + , memMap + , memUnmap + , memProtect + , memRegions - -- * Error handling - Error(..), - errno, - strerror, + -- * Context operations + , Context + , contextAlloc + , contextSave + , contextRestore - -- * Misc. - version, -) where + -- * Error handling + , Error(..) + , errno + , strerror + + -- * Misc. + , version + ) where import Control.Monad (liftM) import Control.Monad.Trans.Class (lift) @@ -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. ------------------------------------------------------------------------------- diff --git a/bindings/haskell/src/Unicorn/CPU/Arm.chs b/bindings/haskell/src/Unicorn/CPU/Arm.chs index fbc3294c..138bf179 100644 --- a/bindings/haskell/src/Unicorn/CPU/Arm.chs +++ b/bindings/haskell/src/Unicorn/CPU/Arm.chs @@ -8,22 +8,25 @@ License : GPL-2 Definitions for the ARM architecture. -} -module Unicorn.CPU.Arm ( - Register(..), -) where +module Unicorn.CPU.Arm + ( + Register(..) + ) where import Unicorn.Internal.Core (Reg) -{# context lib="unicorn" #} +{# context lib = "unicorn" #} #include -- | 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, Bounded) #} + { underscoreToCase } + omit ( UC_ARM_REG_INVALID + , UC_ARM_REG_ENDING + ) + with prefix = "UC_ARM_REG_" + deriving (Show, Eq, Bounded) +#} instance Reg Register diff --git a/bindings/haskell/src/Unicorn/CPU/Arm64.chs b/bindings/haskell/src/Unicorn/CPU/Arm64.chs index 6174ef89..f4f1dec3 100644 --- a/bindings/haskell/src/Unicorn/CPU/Arm64.chs +++ b/bindings/haskell/src/Unicorn/CPU/Arm64.chs @@ -8,22 +8,25 @@ License : GPL-2 Definitions for the ARM64 (ARMv8) architecture. -} -module Unicorn.CPU.Arm64 ( - Register(..), -) where +module Unicorn.CPU.Arm64 + ( + Register(..) + ) where import Unicorn.Internal.Core (Reg) -{# context lib="unicorn" #} +{# context lib = "unicorn" #} #include -- | 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, Bounded) #} + { underscoreToCase } + omit ( UC_ARM64_REG_INVALID + , UC_ARM64_REG_ENDING + ) + with prefix = "UC_ARM64_REG_" + deriving (Show, Eq, Bounded) +#} instance Reg Register diff --git a/bindings/haskell/src/Unicorn/CPU/M68k.chs b/bindings/haskell/src/Unicorn/CPU/M68k.chs index 25753aa4..b06ffb30 100644 --- a/bindings/haskell/src/Unicorn/CPU/M68k.chs +++ b/bindings/haskell/src/Unicorn/CPU/M68k.chs @@ -8,22 +8,25 @@ License : GPL-2 Definitions for the MK68K architecture. -} -module Unicorn.CPU.M68k ( - Register(..), -) where +module Unicorn.CPU.M68k + ( + Register(..) + ) where import Unicorn.Internal.Core (Reg) -{# context lib="unicorn" #} +{# context lib = "unicorn" #} #include -- | 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, Bounded) #} + { underscoreToCase } + omit ( UC_M68K_REG_INVALID + , UC_M68K_REG_ENDING + ) + with prefix = "UC_M68K_REG_" + deriving (Show, Eq, Bounded) +#} instance Reg Register diff --git a/bindings/haskell/src/Unicorn/CPU/Mips.chs b/bindings/haskell/src/Unicorn/CPU/Mips.chs index b234ba72..8ec5db4d 100644 --- a/bindings/haskell/src/Unicorn/CPU/Mips.chs +++ b/bindings/haskell/src/Unicorn/CPU/Mips.chs @@ -8,54 +8,58 @@ License : GPL-2 Definitions for the MIPS architecture. -} -module Unicorn.CPU.Mips ( - Register(..), -) where +module Unicorn.CPU.Mips + ( + Register(..) + ) where import Unicorn.Internal.Core (Reg) -{# context lib="unicorn" #} +{# context lib = "unicorn" #} #include -- | 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, Bounded) #} + { 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) +#} instance Reg Register diff --git a/bindings/haskell/src/Unicorn/CPU/Sparc.chs b/bindings/haskell/src/Unicorn/CPU/Sparc.chs index a94c1b22..e54262bd 100644 --- a/bindings/haskell/src/Unicorn/CPU/Sparc.chs +++ b/bindings/haskell/src/Unicorn/CPU/Sparc.chs @@ -8,22 +8,25 @@ License : GPL-2 Definitions for the SPARC architecture. -} -module Unicorn.CPU.Sparc ( - Register(..), -) where +module Unicorn.CPU.Sparc + ( + Register(..) + ) where import Unicorn.Internal.Core (Reg) -{# context lib="unicorn" #} +{# context lib = "unicorn" #} #include -- | 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, Bounded) #} + { underscoreToCase } + omit (UC_SPARC_REG_INVALID + , UC_SPARC_REG_ENDING + ) + with prefix = "UC_SPARC_REG_" + deriving (Show, Eq, Bounded) +#} instance Reg Register diff --git a/bindings/haskell/src/Unicorn/CPU/X86.chs b/bindings/haskell/src/Unicorn/CPU/X86.chs index eb99c978..56608c17 100644 --- a/bindings/haskell/src/Unicorn/CPU/X86.chs +++ b/bindings/haskell/src/Unicorn/CPU/X86.chs @@ -8,11 +8,12 @@ License : GPL-2 Definitions for the X86 architecture. -} -module Unicorn.CPU.X86 ( - Mmr(..), - Register(..), - Instruction(..), -) where +module Unicorn.CPU.X86 + ( + Mmr(..) + , Register(..) + , Instruction(..) + ) where import Control.Applicative import Data.Word @@ -20,18 +21,18 @@ import Foreign import Unicorn.Internal.Core (Reg) -{# context lib="unicorn" #} +{# context lib = "unicorn" #} #include -- | 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 sizeOf _ = {# sizeof uc_x86_mmr #} @@ -48,18 +49,22 @@ instance Storable Mmr where -- | 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, Bounded) #} + { underscoreToCase } + omit ( UC_X86_REG_INVALID + , UC_X86_REG_ENDING + ) + with prefix = "UC_X86_REG_" + 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) - with prefix="UC_X86_INS_" - deriving (Show, Eq, Bounded) #} + { underscoreToCase } + omit ( UC_X86_INS_INVALID + , UC_X86_INS_ENDING + ) + with prefix = "UC_X86_INS_" + deriving (Show, Eq, Bounded) +#} diff --git a/bindings/haskell/src/Unicorn/Hook.hs b/bindings/haskell/src/Unicorn/Hook.hs index 2e13ebc4..9595a140 100644 --- a/bindings/haskell/src/Unicorn/Hook.hs +++ b/bindings/haskell/src/Unicorn/Hook.hs @@ -6,36 +6,36 @@ 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, + -- * 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 + -- * Hook callback management + , codeHookAdd + , interruptHookAdd + , blockHookAdd + , inHookAdd + , outHookAdd + , syscallHookAdd + , memoryHookAdd + , memoryEventHookAdd + , hookDel + ) where import Control.Monad import Control.Monad.Trans.Class @@ -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 = diff --git a/bindings/haskell/src/Unicorn/Internal/Core.chs b/bindings/haskell/src/Unicorn/Internal/Core.chs index a69f51c3..dcc6a7fc 100644 --- a/bindings/haskell/src/Unicorn/Internal/Core.chs +++ b/bindings/haskell/src/Unicorn/Internal/Core.chs @@ -17,31 +17,34 @@ import Control.Monad import Control.Monad.Trans.Either (EitherT) import Foreign -{# context lib="unicorn" #} +{# context lib = "unicorn" #} #include #include "unicorn_wrapper.h" -- | The Unicorn engine. {# pointer *uc_engine as Engine - foreign finalizer uc_close_wrapper as close - newtype #} + 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 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) -- | Errors encountered by the Unicorn API. These values are returned by -- 'errno'. {# enum uc_err as Error - {underscoreToCase} - with prefix="UC_" - deriving (Show, Eq, Bounded) #} + { underscoreToCase } + with prefix = "UC_" + deriving (Show, Eq, Bounded) +#} -- | The emulator runs in the IO monad and allows for the handling of errors -- "under the hood". diff --git a/bindings/haskell/src/Unicorn/Internal/Hook.chs b/bindings/haskell/src/Unicorn/Internal/Hook.chs index 00a8a123..affed872 100644 --- a/bindings/haskell/src/Unicorn/Internal/Hook.chs +++ b/bindings/haskell/src/Unicorn/Internal/Hook.chs @@ -11,54 +11,54 @@ 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, + -- * 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 marshallin + , marshalCodeHook + , marshalInterruptHook + , marshalBlockHook + , marshalInHook + , marshalOutHook + , marshalSyscallHook + , marshalMemoryHook + , marshalMemoryReadHook + , marshalMemoryWriteHook + , marshalMemoryEventHook - -- * Hook registration and deletion bindings - ucHookAdd, - ucInsnHookAdd, - ucHookDel, -) where + -- * 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 #} +{# context lib = "unicorn" #} + #include #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) @@ -92,47 +93,55 @@ type Hook = {# type uc_hook #} -- 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, Bounded) #} + { 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 + , UC_HOOK_MEM_READ_AFTER + ) + with prefix = "UC_" + 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) - with prefix="UC_" - deriving (Show, Eq, Bounded) #} + { 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, 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) - with prefix="UC_" - deriving (Show, Eq, Bounded) #} + { 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 + , UC_HOOK_MEM_READ_AFTER + ) + with prefix = "UC_" + deriving (Show, Eq, Bounded) +#} -- | Unify the hook types with a type class class Enum a => HookTypeC a @@ -143,9 +152,10 @@ instance HookTypeC MemoryEventHookType -- | Memory access. {# enum uc_mem_type as MemoryAccess - {underscoreToCase} - with prefix="UC_" - deriving (Show, Eq, Bounded) #} + { underscoreToCase } + with prefix = "UC_" + deriving (Show, Eq, Bounded) +#} ------------------------------------------------------------------------------- -- Hook callbacks @@ -159,16 +169,18 @@ type CodeHook a = Engine -- ^ 'Unicorn' engine handle -> a -- ^ User data passed to tracing APIs -> IO () -type CCodeHook = EnginePtr -> Word64 -> Word32 -> Ptr () -> IO () +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 + uc <- mkEngineNC ucPtr userData <- castPtrAndPeek userDataPtr let maybeSize = if size == 0 then Nothing else Just $ fromIntegral size @@ -186,10 +198,11 @@ 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 + uc <- mkEngineNC ucPtr userData <- castPtrAndPeek userDataPtr interruptHook uc (fromIntegral intNo) userData @@ -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,10 +228,11 @@ 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 + uc <- mkEngineNC ucPtr userData <- castPtrAndPeek userDataPtr inHook uc (fromIntegral port) (fromIntegral size) userData @@ -232,13 +247,15 @@ 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 + uc <- mkEngineNC ucPtr userData <- castPtrAndPeek userDataPtr outHook uc (fromIntegral port) (fromIntegral size) (fromIntegral value) userData @@ -251,13 +268,15 @@ 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 + uc <- mkEngineNC $ castPtr ucPtr userData <- castPtrAndPeek userDataPtr syscallHook uc userData @@ -281,13 +300,15 @@ 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 + uc <- mkEngineNC ucPtr userData <- castPtrAndPeek userDataPtr let memAccess = toMemAccess memAccessI maybeValue = case memAccess of @@ -304,10 +325,11 @@ 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 + uc <- mkEngineNC ucPtr userData <- castPtrAndPeek userDataPtr memoryReadHook uc address (fromIntegral size) userData @@ -321,10 +343,11 @@ 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 + uc <- mkEngineNC ucPtr userData <- castPtrAndPeek userDataPtr memoryWriteHook uc address (fromIntegral size) (fromIntegral value) userData @@ -351,15 +374,17 @@ 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 + uc <- mkEngineNC ucPtr userData <- castPtrAndPeek userDataPtr - let memAccess = toMemAccess memAccessI + let memAccess = toMemAccess memAccessI maybeValue = case memAccess of MemReadUnmapped -> Nothing MemReadProt -> Nothing @@ -369,7 +394,7 @@ marshalMemoryEventHook eventMemoryHook = res <- eventMemoryHook uc memAccess address (fromIntegral size) maybeValue userData return $ boolToInt res - where boolToInt True = 1 + where boolToInt True = 1 boolToInt False = 0 @@ -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 diff --git a/bindings/haskell/src/Unicorn/Internal/Unicorn.chs b/bindings/haskell/src/Unicorn/Internal/Unicorn.chs index 53bf82f5..30605282 100644 --- a/bindings/haskell/src/Unicorn/Internal/Unicorn.chs +++ b/bindings/haskell/src/Unicorn/Internal/Unicorn.chs @@ -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, -) where + -- * Function bindings + , 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 +#include "unicorn_wrapper.h" ------------------------------------------------------------------------------- -- Types @@ -58,29 +65,33 @@ import Unicorn.Internal.Util -- | CPU architecture. {# enum uc_arch as Architecture - {underscoreToCase} - with prefix="UC_" - deriving (Show, Eq, Bounded) #} + { underscoreToCase } + with prefix = "UC_" + deriving (Show, Eq, Bounded) +#} -- | CPU hardware mode. {# enum uc_mode as Mode - {underscoreToCase} - with prefix="UC_" - deriving (Show, Eq, Bounded) #} + { underscoreToCase } + with prefix = "UC_" + deriving (Show, Eq, Bounded) +#} -- | Memory permissions. {# enum uc_prot as MemoryPermission - {underscoreToCase} - with prefix="UC_" - deriving (Show, Eq, Bounded) #} + { underscoreToCase } + with prefix = "UC_" + 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 sizeOf _ = {# sizeof uc_mem_region #} @@ -99,121 +110,174 @@ instance Storable MemoryRegion where -- | Query types for the 'query' API. {# enum uc_query_type as QueryType - {underscoreToCase} - with prefix="UC_" - deriving (Show, Eq, Bounded) #} + { underscoreToCase } + with prefix = "UC_" + 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 ------------------------------------------------------------------------------- {# fun uc_reg_write as ^ - `Reg r' => - {`Engine', - enumToNum `r', - castPtr `Ptr Int64'} - -> `Error' #} + `Reg r' => + { `Engine' + , enumToNum `r' + , castPtr `Ptr Int64' + } -> `Error' +#} {# fun uc_reg_read as ^ - `Reg r' => - {`Engine', - enumToNum `r', - allocaInt64ToVoid- `Int64' castPtrAndPeek*} - -> `Error' #} + `Reg r' => + { `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) diff --git a/bindings/haskell/src/Unicorn/Internal/Util.hs b/bindings/haskell/src/Unicorn/Internal/Util.hs index 3af6a513..edaf3430 100644 --- a/bindings/haskell/src/Unicorn/Internal/Util.hs +++ b/bindings/haskell/src/Unicorn/Internal/Util.hs @@ -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 diff --git a/bindings/haskell/src/cbits/unicorn_wrapper.c b/bindings/haskell/src/cbits/unicorn_wrapper.c index 1ee60706..fdbbe6d8 100644 --- a/bindings/haskell/src/cbits/unicorn_wrapper.c +++ b/bindings/haskell/src/cbits/unicorn_wrapper.c @@ -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); +} diff --git a/bindings/haskell/src/include/unicorn_wrapper.h b/bindings/haskell/src/include/unicorn_wrapper.h index 76d414aa..e717c408 100644 --- a/bindings/haskell/src/include/unicorn_wrapper.h +++ b/bindings/haskell/src/include/unicorn_wrapper.h @@ -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 diff --git a/bindings/haskell/unicorn.cabal b/bindings/haskell/unicorn.cabal index 027e09d2..d050c538 100644 --- a/bindings/haskell/unicorn.cabal +++ b/bindings/haskell/unicorn.cabal @@ -13,8 +13,9 @@ copyright: (c) 2016, Adrian Herrera category: System build-type: Simple stability: experimental -cabal-version: >=1.10 -extra-source-files: cbits/, include/ +cabal-version: >= 1.10 +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