yizhi-js-lib/favicon-trap
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Haskell bindings update (#767)

Browse Source 
* haskell: Properly handle invalid memory access

* haskell: source cleanup

* haskell: added support for batch reg read/write
This commit is contained in:
Adrian Herrera
2017-02-26 02:27:35 +01:00
committed by Nguyen Anh Quynh
parent a40e5aae09
commit c090f198ad
8 changed files with 250 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

55
bindings/haskell/src/Unicorn.hs
View File

@ -25,6 +25,8 @@ module Unicorn
-- * Register operations
, regWrite
, regRead
, regWriteBatch
, regReadBatch
-- * Memory operations
, MemoryPermission(..)
@ -140,13 +142,11 @@ stop uc = do
-- | Write to register.
regWrite :: Reg r
=> Engine -- ^ 'Unicorn' engine handle
-> r -- ^ Register ID to write to
-> r -- ^ Register to write to
-> Int64 -- ^ Value to write to register
-> Emulator () -- ^ An 'Error' on failure
regWrite uc regId value = do
err <- lift . alloca $ \ptr -> do
poke ptr value
ucRegWrite uc regId ptr
regWrite uc reg value = do
err <- lift $ ucRegWrite uc reg value
if err == ErrOk then
right ()
else
@ -155,16 +155,49 @@ regWrite uc regId value = do
-- | Read register value.
regRead :: Reg r
=> Engine -- ^ 'Unicorn' engine handle
-> r -- ^ Register ID to read from
-> r -- ^ Register to read from
-> Emulator Int64 -- ^ The value read from the register on success,
-- or an 'Error' on failure
regRead uc regId = do
(err, val) <- lift $ ucRegRead uc regId
regRead uc reg = do
(err, val) <- lift $ ucRegRead uc reg
if err == ErrOk then
right val
else
left err
-- | Write multiple register values.
regWriteBatch :: Reg r
=> Engine -- ^ 'Unicorn' engine handle
-> [r] -- ^ List of registers to write to
-> [Int64] -- ^ List of values to write to the registers
-> Emulator () -- ^ An 'Error' on failure
regWriteBatch uc regs vals = do
err <- lift $ ucRegWriteBatch uc regs vals (length regs)
if err == ErrOk then
right ()
else
left err
-- | Read multiple register values.
regReadBatch :: Reg r
=> Engine -- ^ 'Unicorn' engine handle
-> [r] -- ^ List of registers to read from
-> Emulator [Int64] -- ^ A list of register values on success,
-- or an 'Error' on failure
regReadBatch uc regs = do
-- Allocate an array of the given size
let size = length regs
result <- lift . allocaArray size $ \array -> do
err <- ucRegReadBatch uc regs array size
if err == ErrOk then
-- If ucRegReadBatch completed successfully, pack the contents of
-- the array into a list and return it
liftM Right (peekArray size array)
else
-- Otherwise return the error
return $ Left err
hoistEither result
-------------------------------------------------------------------------------
-- Memory operations
-------------------------------------------------------------------------------
@ -190,12 +223,12 @@ memRead :: Engine -- ^ 'Unicorn' engine handle
-- an 'Error' on failure
memRead uc address size = do
-- Allocate an array of the given size
result <- lift . allocaArray size $ \ptr -> do
err <- ucMemRead uc address ptr size
result <- lift . allocaArray size $ \array -> do
err <- ucMemRead uc address array size
if err == ErrOk then
-- If ucMemRead completed successfully, pack the contents of the
-- array into a ByteString and return it
liftM (Right . pack) (peekArray size ptr)
liftM (Right . pack) (peekArray size array)
else
-- Otherwise return the error
return $ Left err

4
bindings/haskell/src/Unicorn/Internal/Hook.chs
View File

@ -314,7 +314,7 @@ marshalMemoryHook memoryHook =
maybeValue = case memAccess of
MemRead -> Nothing
MemWrite -> Just $ fromIntegral value
_ -> undefined -- XX Handle this?
_ -> error "Invalid memory access"
memoryHook uc memAccess address (fromIntegral size) maybeValue userData
-- | Callback function for hooking memory reads.
@ -390,7 +390,7 @@ marshalMemoryEventHook eventMemoryHook =
MemReadProt -> Nothing
MemWriteUnmapped -> Just $ fromIntegral value
MemWriteProt -> Just $ fromIntegral value
_ -> undefined -- XX Handle this?
_ -> error "Invalid memory access"
res <- eventMemoryHook uc memAccess address (fromIntegral size)
maybeValue userData
return $ boolToInt res

70
bindings/haskell/src/Unicorn/Internal/Unicorn.chs
View File

@ -28,6 +28,8 @@ module Unicorn.Internal.Unicorn
, ucEmuStop
, ucRegWrite
, ucRegRead
, ucRegWriteBatch
, ucRegReadBatch
, ucMemWrite
, ucMemRead
, ucMemMap
@ -154,7 +156,8 @@ mkContext ptr =
, `Word64'
, `Word64'
, `Int'
, `Int'} -> `Error'
, `Int'
} -> `Error'
#}
{# fun uc_emu_stop as ^
@ -166,19 +169,37 @@ mkContext ptr =
-- Register operations
-------------------------------------------------------------------------------
{# fun uc_reg_write as ^
{# fun uc_reg_write_wrapper as ucRegWrite
`Reg r' =>
{ `Engine'
, enumToNum `r'
, castPtr `Ptr Int64'
, withIntegral* `Int64'
} -> `Error'
#}
{# fun uc_reg_read as ^
{# fun uc_reg_read_wrapper as ucRegRead
`Reg r' =>
{ `Engine'
, enumToNum `r'
, allocaInt64ToVoid- `Int64' castPtrAndPeek*
, alloca- `Int64' castPtrAndPeek*
} -> `Error'
#}
{# fun uc_reg_write_batch_wrapper as ucRegWriteBatch
`Reg r' =>
{ `Engine'
, withEnums* `[r]'
, integralListToArray* `[Int64]'
, `Int'
} -> `Error'
#}
{# fun uc_reg_read_batch_wrapper as ucRegReadBatch
`Reg r' =>
{ `Engine'
, withEnums* `[r]'
, castPtr `Ptr Int64'
, `Int'
} -> `Error'
#}
@ -197,7 +218,8 @@ mkContext ptr =
{ `Engine'
, `Word64'
, castPtr `Ptr Word8'
, `Int'} -> `Error'
, `Int'
} -> `Error'
#}
{# fun uc_mem_map as ^
@ -205,7 +227,8 @@ mkContext ptr =
, `Word64'
, `Int'
, combineEnums `[MemoryPermission]'
} -> `Error' #}
} -> `Error'
#}
{# fun uc_mem_unmap as ^
{ `Engine'
@ -296,13 +319,32 @@ expandMemPerms perms =
checkRWE _ [] =
[]
allocaInt64ToVoid :: (Ptr () -> IO b)
-> IO b
allocaInt64ToVoid f =
alloca $ \(ptr :: Ptr Int64) -> poke ptr 0 >> f (castPtr ptr)
withIntegral :: (Integral a, Num b, Storable b)
=> a
-> (Ptr b -> IO c)
-> IO c
withIntegral =
with . fromIntegral
withByteStringLen :: ByteString
-> ((Ptr (), CULong) -> IO a)
-> IO a
withByteStringLen :: Integral a
=> ByteString
-> ((Ptr (), a) -> IO b)
-> IO b
withByteStringLen bs f =
useAsCStringLen bs $ \(ptr, len) -> f (castPtr ptr, fromIntegral len)
withEnums :: Enum a
=> [a]
-> (Ptr b -> IO c)
-> IO c
withEnums l f =
let ints :: [CInt] = map enumToNum l in
withArray ints $ \ptr -> f (castPtr ptr)
integralListToArray :: (Integral a, Storable b, Num b)
=> [a]
-> (Ptr b -> IO c)
-> IO c
integralListToArray l f =
let l' = map fromIntegral l in
withArray l' $ \array -> f array

38
bindings/haskell/src/cbits/unicorn_wrapper.c
View File

@ -1,3 +1,5 @@
#include <stdlib.h>
#include "unicorn_wrapper.h"
void uc_close_wrapper(uc_engine *uc) {
@ -7,6 +9,42 @@ void uc_close_wrapper(uc_engine *uc) {
void uc_close_dummy(uc_engine *uc) {
}
uc_err uc_reg_write_wrapper(uc_engine *uc, int regid, const int64_t *value) {
return uc_reg_write(uc, regid, (const void*) value);
}
uc_err uc_reg_read_wrapper(uc_engine *uc, int regid, int64_t *value) {
return uc_reg_read(uc, regid, (void*) value);
}
uc_err uc_reg_write_batch_wrapper(uc_engine *uc, int *regs, int64_t *vals, int count) {
void **valsPtr = malloc(sizeof(void*) * count);
int i;
for (i = 0; i < count; ++i) {
valsPtr[i] = (void*) &vals[i];
}
uc_err ret = uc_reg_write_batch(uc, regs, (void *const*) valsPtr, count);
free(valsPtr);
return ret;
}
uc_err uc_reg_read_batch_wrapper(uc_engine *uc, int *regs, int64_t *vals, int count) {
void **valsPtr = malloc(sizeof(void*) * count);
int i;
for (i = 0; i < count; ++i) {
valsPtr[i] = (void*) &vals[i];
}
uc_err ret = uc_reg_read_batch(uc, regs, valsPtr, count);
free(valsPtr);
return ret;
}
void uc_free_wrapper(void *mem) {
uc_free(mem);
}

9
bindings/haskell/src/include/unicorn_wrapper.h
View File

@ -1,6 +1,7 @@
#ifndef UNICORN_WRAPPER_H
#define UNICORN_WRAPPER_H
#include <stdint.h>
#include <unicorn/unicorn.h>
/*
@ -13,6 +14,14 @@ void uc_close_wrapper(uc_engine *uc);
*/
void uc_close_dummy(uc_engine *uc);
/*
* Wrappers for register read/write functions that accept int64_t pointers.
*/
uc_err uc_reg_write_wrapper(uc_engine *uc, int regid, const int64_t *value);
uc_err uc_reg_read_wrapper(uc_engine *uc, int regid, int64_t *value);
uc_err uc_reg_write_batch_wrapper(uc_engine *uc, int *regs, int64_t *vals, int count);
uc_err uc_reg_read_batch_wrapper(uc_engine *uc, int *regs, int64_t *vals, int count);
/*
* Wrap Unicorn's uc_free function and ignore the returned error code.
*/