X-Git-Url: http://wien.tomnetworks.com/gitweb/?a=blobdiff_plain;f=Mate%2FX86TrapHandling.hs;h=493a3ceaf1b1a3a4a45c2d29bcacbeb6034a7a2e;hb=094e3cea9aa9d638b071fb52a12f04f6ddd80dc1;hp=f383c2d3635afdec98079b70931d7101cf929374;hpb=7e3cda1c8cfe2f1e91816277969391c6d91bfb6a;p=mate.git diff --git a/Mate/X86TrapHandling.hs b/Mate/X86TrapHandling.hs index f383c2d..493a3ce 100644 --- a/Mate/X86TrapHandling.hs +++ b/Mate/X86TrapHandling.hs @@ -2,85 +2,129 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ForeignFunctionInterface #-} #include "debug.h" -module Mate.X86TrapHandling where +module Mate.X86TrapHandling ( + mateHandler, + register_signal + ) where import qualified Data.Map as M +import qualified Data.ByteString.Lazy as B import Foreign import Foreign.C.Types import Mate.Types -import Mate.MethodPool +import {-# SOURCE #-} Mate.MethodPool import Mate.ClassPool foreign import ccall "register_signal" register_signal :: IO () +data TrapType = + StaticMethodCall + | StaticFieldAccess + | VirtualMethodCall Bool + | InterfaceMethodCall Bool + | InstanceOfMiss B.ByteString + | NewObjectTrap B.ByteString + | NoKnownTrap String -getTrapType :: CUInt -> CUInt -> IO CUInt -getTrapType signal_from from2 = do - tmap <- getTrapMap +getTrapType :: TrapMap -> CPtrdiff -> CPtrdiff -> TrapType +getTrapType tmap signal_from from2 = case M.lookup (fromIntegral signal_from) tmap of - (Just (MI _)) -> return 0 - (Just (SFI _)) -> return 2 - (Just _) -> error "getTrapMap: doesn't happen" + (Just (StaticMethod _)) -> StaticMethodCall + (Just (StaticField _)) -> StaticFieldAccess + (Just (InstanceOf cn)) -> InstanceOfMiss cn + (Just (NewObject cn)) -> NewObjectTrap cn + (Just _) -> NoKnownTrap "getTrapMap: doesn't happen" -- maybe we've a hit on the second `from' value Nothing -> case M.lookup (fromIntegral from2) tmap of - (Just (VI True _)) -> return 1 - (Just (VI False _)) -> return 5 - (Just (II True _)) -> return 4 - (Just (II False _)) -> return 8 - (Just _) -> error "getTrapType: abort #1 :-(" - Nothing -> error $ "getTrapType: abort #2 :-(" ++ show signal_from ++ ", " ++ show from2 ++ ", " ++ show tmap - -foreign export ccall mateHandler :: CUInt -> CUInt -> CUInt -> CUInt -> IO CUInt -mateHandler :: CUInt -> CUInt -> CUInt -> CUInt -> IO CUInt -mateHandler eip eax ebx esp = do + (Just (VirtualMethod imm8 _)) -> VirtualMethodCall imm8 + (Just (InterfaceMethod imm8 _)) -> InterfaceMethodCall imm8 + (Just _) -> NoKnownTrap "getTrapType: abort #1 :-(" + Nothing -> NoKnownTrap $ "getTrapType: abort #2 :-(" ++ show signal_from ++ ", " ++ show from2 ++ ", " ++ show tmap + +foreign export ccall mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff +mateHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> CPtrdiff -> IO CPtrdiff +mateHandler eip eax ebx esp esi = do callerAddr <- callerAddrFromStack esp - blah <- getTrapType eip callerAddr - case blah of - 0 -> staticCallHandler eip - 1 -> invokeHandler eax eax esp True - 5 -> invokeHandler eax eax esp False - 4 -> invokeHandler eax ebx esp True - 8 -> invokeHandler eax ebx esp False - 2 -> staticFieldHandler eip - x -> error $ "wtf: " ++ show x - -staticCallHandler :: CUInt -> IO CUInt + tmap <- getTrapMap + case getTrapType tmap eip callerAddr of + StaticMethodCall -> staticCallHandler eip + StaticFieldAccess -> staticFieldHandler eip + (InstanceOfMiss cn) -> instanceOfMissHandler eip cn + (NewObjectTrap cn) -> newObjectHandler eip cn + VirtualMethodCall imm8 -> invokeHandler eax eax esp imm8 + InterfaceMethodCall imm8 -> invokeHandler eax ebx esp imm8 + NoKnownTrap err -> + case esi of + 0x13371234 -> return (-1) + _ -> error err + +staticCallHandler :: CPtrdiff -> IO CPtrdiff staticCallHandler eip = do - -- the actual insn to patch is displaced by two bytes - let insn_ptr = intPtrToPtr (fromIntegral (eip - 2)) :: Ptr CUChar - -- call offset is displaced by one byte - let imm_ptr = intPtrToPtr (fromIntegral (eip - 1)) :: Ptr CUInt + -- the actual insn to patch as pointer + let insn_ptr = intPtrToPtr (fromIntegral eip) :: Ptr CUChar + -- call offset is displaced by one byte (as the first byte is the opcode) + let imm_ptr = intPtrToPtr (fromIntegral (eip + 1)) :: Ptr CPtrdiff -- in codegen we set the immediate to some magic value -- in order to produce a SIGILL signal. we also do a safety -- check here, if we're really the "owner" of this signal. checkMe <- peek imm_ptr - case checkMe == 0x90ffff90 of - True -> do + if checkMe == 0x909090ff then + do entryAddr <- getMethodEntry eip 0 - poke insn_ptr 0xe8 -- call opcode - -- it's a relative call, so we have to calculate the offset. why "+ 3"? + poke insn_ptr 0xe8 -- `call' opcode + -- it's a relative call, so we have to calculate the offset. why "+ 5"? -- (1) the whole insn is 5 bytes long - -- (2) begin of insn is displaced by 2 bytes - -- (3) offset is calculated wrt to the beginning of the next insn - poke imm_ptr (entryAddr - (eip + 3)) - return (eip - 2) - False -> error "staticCallHandler: something is wrong here. abort\n" + -- (2) offset is calculated wrt to the beginning of the next insn + poke imm_ptr (entryAddr - (eip + 5)) + return eip + else error "staticCallHandler: something is wrong here. abort\n" -staticFieldHandler :: CUInt -> IO CUInt +staticFieldHandler :: CPtrdiff -> IO CPtrdiff staticFieldHandler eip = do -- patch the offset here, first two bytes are part of the insn (opcode + reg) - let imm_ptr = intPtrToPtr (fromIntegral (eip + 2)) :: Ptr CUInt + let imm_ptr = intPtrToPtr (fromIntegral (eip + 2)) :: Ptr CPtrdiff checkMe <- peek imm_ptr - case checkMe == 0x00000000 of - True -> do + if checkMe == 0x00000000 then + do getStaticFieldAddr eip >>= poke imm_ptr return eip - False -> error "staticFieldHandler: something is wrong here. abort.\n" + else error "staticFieldHandler: something is wrong here. abort.\n" + +instanceOfMissHandler :: CPtrdiff -> B.ByteString -> IO CPtrdiff +instanceOfMissHandler eip classname = do + -- first byte is going to be the opcode + let insn_ptr = intPtrToPtr (fromIntegral eip) :: Ptr CUChar + -- the next four bytes are the immediate + let imm_ptr = intPtrToPtr (fromIntegral (eip + 1)) :: Ptr CPtrdiff + checkMe <- peek imm_ptr + if checkMe == 0x909090ff then -- safety check... + do + mtable <- getMethodTable classname + poke imm_ptr (fromIntegral mtable) + poke insn_ptr 0xba -- `mov edx' opcode + return eip + else error "instanceOfMissHandler: something is wrong here. abort.\n" + +newObjectHandler :: CPtrdiff -> B.ByteString -> IO CPtrdiff +newObjectHandler eip classname = do + let push_insn_ptr = intPtrToPtr (fromIntegral eip) :: Ptr CUChar + let push_imm_ptr = intPtrToPtr (fromIntegral (eip + 1)) :: Ptr CPtrdiff + let mov_imm_ptr = intPtrToPtr (fromIntegral (eip + 16)) :: Ptr CPtrdiff + checkMe <- peek mov_imm_ptr + if checkMe == 0x13371337 + then do + objsize <- getObjectSize classname + mtable <- getMethodTable classname + poke push_insn_ptr 0x68 -- push_imm insn + poke push_imm_ptr (fromIntegral objsize) + poke mov_imm_ptr (fromIntegral mtable) + return eip + else error "newObjectHandler: something is wrong here. abort.\n" -invokeHandler :: CUInt -> CUInt -> CUInt -> Bool -> IO CUInt +invokeHandler :: CPtrdiff -> CPtrdiff -> CPtrdiff -> Bool -> IO CPtrdiff invokeHandler method_table table2patch esp imm8 = do -- table2patch: note, that can be a method-table or a interface-table callerAddr <- callerAddrFromStack esp @@ -91,18 +135,18 @@ invokeHandler method_table table2patch esp imm8 = do return entryAddr -callerAddrFromStack :: CUInt -> IO CUInt +callerAddrFromStack :: CPtrdiff -> IO CPtrdiff callerAddrFromStack = peek . intPtrToPtr . fromIntegral -offsetOfCallInsn8 :: CUInt -> IO CUInt +offsetOfCallInsn8 :: CPtrdiff -> IO CPtrdiff offsetOfCallInsn8 esp = do - let ret_ptr = intPtrToPtr (fromIntegral esp) :: Ptr CUInt + let ret_ptr = intPtrToPtr (fromIntegral esp) :: Ptr CPtrdiff ret <- peek ret_ptr retval <- peek (intPtrToPtr (fromIntegral (ret - 1)) :: Ptr CUChar) return $ fromIntegral retval -offsetOfCallInsn32 :: CUInt -> IO CUInt +offsetOfCallInsn32 :: CPtrdiff -> IO CPtrdiff offsetOfCallInsn32 esp = do - let ret_ptr = intPtrToPtr (fromIntegral esp) :: Ptr CUInt + let ret_ptr = intPtrToPtr (fromIntegral esp) :: Ptr CPtrdiff ret <- peek ret_ptr peek (intPtrToPtr $ fromIntegral (ret - 4))