Mate.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2 {-# LANGUAGE TemplateHaskell, FlexibleInstances #-}
   3 {-# LANGUAGE ForeignFunctionInterface #-}
   4 module Main where
   5
   6 import Data.Binary
   7 import Data.String
   8 import System.Environment hiding (getEnv)
   9 import qualified Data.Map as M
  10 import qualified Data.ByteString.Lazy as B
  11
  12 import Text.Printf
  13
  14 import Control.Monad
  15
  16 import qualified JVM.Assembler as J
  17 import JVM.Assembler hiding (Instruction)
  18 import JVM.Common
  19 import JVM.ClassFile
  20 import JVM.Converter
  21 import JVM.Dump
  22
  23 import Foreign
  24 import Foreign.Ptr
  25 import Foreign.C.Types
  26
  27 import Harpy
  28 import Harpy.X86Disassembler
  29
  30 import Utilities
  31
  32 foreign import ccall "dynamic"
  33    code_void :: FunPtr (CInt -> IO CInt) -> (CInt -> IO CInt)
  34
  35 foreign import ccall "getaddr"
  36   getaddr :: CUInt
  37
  38 foreign import ccall "callertrap"
  39   callertrap :: IO ()
  40
  41
  42 $(callDecl "callAsWord32" [t|Word32|])
  43
  44 main = do
  45   args <- getArgs
  46   case args of
  47     [clspath] -> do
  48       clsFile <- decodeFile clspath
  49       let cp = constsPool (clsFile :: Class Pointers)
  50       putStrLn "==== constpool: ===="
  51       putStrLn $ showListIx $ M.elems cp
  52       cf <- parseClassFile clspath
  53       putStrLn "==== classfile dump: ===="
  54       dumpClass cf
  55       putStrLn "==== random stuff: ===="
  56       let mainmethod = lookupMethod "main" cf -- "main|([Ljava/lang/String;)V" cf
  57       case mainmethod of
  58         Nothing -> putStrLn "no main found"
  59         Just main ->
  60           case attrByName main "Code" of
  61             Nothing -> putStrLn "no code attr found"
  62             Just bytecode -> do
  63               putStrLn "woot, running now"
  64               allocaArray 26 (\ p -> mapM_ (\ i -> poke (advancePtr p i) 0) [0..25] >> runstuff p bytecode)
  65     _ -> error "Synopsis: dump-class File.class"
  66
  67 runstuff :: Ptr Int32 -> B.ByteString -> IO ()
  68 runstuff env bytecode = do
  69           let emittedcode = (compile (fromIntegral getaddr)) $ codeInstructions $ decodeMethod bytecode
  70           (_, Right ((entryPtr, endOffset), disasm)) <- runCodeGen emittedcode env ()
  71           printf "entry point: 0x%08x\n" ((fromIntegral $ ptrToIntPtr entryPtr) :: Int)
  72
  73
  74           let entryFuncPtr = ((castPtrToFunPtr entryPtr) :: FunPtr (CInt -> IO CInt))
  75           printf "got ptr\n"
  76           result <- code_void entryFuncPtr (fromIntegral 0x1337)
  77           printf "called code_void\n"
  78           let iresult::Int; iresult = fromIntegral result
  79           printf "result: 0x%08x\n" iresult -- expecting (2 * 0x1337) + 0x42 = 0x26b0
  80
  81           result2 <- code_void entryFuncPtr (fromIntegral (-0x20))
  82           let iresult2::Int; iresult2 = fromIntegral result2
  83           printf "result: 0x%08x\n" iresult2 -- expecting 0x2
  84
  85
  86           -- s/mov ebx 0x6666/mov eax 0x6666/
  87           let patchit = plusPtr entryPtr 0xb
  88           poke patchit (0xb8 :: Word8)
  89
  90           result3 <- code_void entryFuncPtr (fromIntegral 0)
  91           let iresult3::Int; iresult3 = fromIntegral result3
  92           printf "result: 0x%08x\n" iresult3 -- expecting 0x6666
  93
  94           printf "disasm:\n"
  95           mapM_ (putStrLn . showAtt) disasm
  96
  97           printf "patched disasm:\n"
  98           Right newdisasm <- disassembleBlock entryPtr endOffset
  99           mapM_ (putStrLn . showAtt) $ newdisasm
 100
 101           let addr :: Int; addr = (fromIntegral getaddr :: Int)
 102           printf "getaddr: 0x%08x\n" addr
 103
 104           return ()
 105
 106
 107 entryCode :: CodeGen e s ()
 108 entryCode = do push ebp
 109                mov ebp esp
 110
 111 exitCode :: CodeGen e s ()
 112 exitCode = do mov esp ebp
 113               pop ebp
 114               ret
 115
 116 compile :: Word32 -> [J.Instruction] -> CodeGen (Ptr Int32) s ((Ptr Word8, Int), [Instruction])
 117 compile trapaddr insn = do
 118   ep <- getEntryPoint
 119   let w32_ep = (fromIntegral $ ptrToIntPtr ep) :: Word32
 120   entryCode
 121   mapM compile_ins insn
 122   push eax
 123   calladdr <- getCodeOffset
 124   -- '5' is the size of the `call' instruction ( + immediate)
 125   let w32_calladdr = 5 + w32_ep + (fromIntegral calladdr) :: Word32
 126   call (trapaddr - w32_calladdr)
 127   pop eax
 128   exitCode
 129   d <- disassemble
 130   end <- getCodeOffset
 131   return ((ep,end),d)
 132
 133 compile_ins :: J.Instruction -> CodeGen (Ptr Int32) s ()
 134 compile_ins (BIPUSH w8) = do mov eax ((fromIntegral w8) :: Word32)
 135 compile_ins (PUTSTATIC w16) = do add eax (Disp 8, ebp) -- add first argument to %eax
 136 compile_ins (GETSTATIC w16) = do nop
 137 compile_ins ICONST_2 = do mov ebx (0x6666 :: Word32) -- patch me!
 138 compile_ins IMUL = do nop
 139   -- mov eax (0 :: Word32)
 140   -- jmp eax
 141 compile_ins RETURN = do nop
 142 compile_ins _ = do nop
 143