From 8edac02a47aea9a38d36f0f3d42594c6981003b6 Mon Sep 17 00:00:00 2001 From: Bernhard Urban Date: Thu, 26 Apr 2012 23:11:29 +0200 Subject: [PATCH] still wtf --- .gitignore | 3 +- Main.hs | 18 +++++++ Makefile | 11 ++-- Mate.hs | 145 ----------------------------------------------------- README | 91 +++++++++++++++++++++++++++++++-- Test.java | 9 ---- trap.c | 17 ------- 7 files changed, 112 insertions(+), 182 deletions(-) create mode 100644 Main.hs delete mode 100644 Mate.hs delete mode 100644 Test.java delete mode 100644 trap.c diff --git a/.gitignore b/.gitignore index df1cda2..8dbf228 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,2 @@ *.hi -*.class -mate +stackoverflow_segv diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..44669ac --- /dev/null +++ b/Main.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +module Main where + +import Data.Word +import Text.Printf +import Foreign + +foreign import ccall "dynamic" + code_void :: FunPtr (IO ()) -> (IO ()) + +main :: IO () +main = do + entryPtr <- (mallocBytes 2) + poke entryPtr (0xc390 :: Word16) -- nop (0x90); ret(0xc3) (little endian order) + + _ <- printf "entry point: 0x%08x\n" ((fromIntegral $ ptrToIntPtr entryPtr) :: Int) + code_void $ castPtrToFunPtr entryPtr + putStrLn "welcome back" diff --git a/Makefile b/Makefile index 7bc23cf..ea512ef 100644 --- a/Makefile +++ b/Makefile @@ -1,11 +1,10 @@ -all: mate Test.class - ./mate Test.class +NAME := stackoverflow_segv -%.class: %.java - javac $< +all: $(NAME) + ./$< -mate: Mate.hs trap.c +$(NAME): Main.hs ghc --make -Wall -O2 $^ -o $@ clean: - rm -f *.hi *.o mate + rm -f *.hi *.o $(NAME) diff --git a/Mate.hs b/Mate.hs deleted file mode 100644 index 3fcfca5..0000000 --- a/Mate.hs +++ /dev/null @@ -1,145 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TemplateHaskell, FlexibleInstances #-} -{-# LANGUAGE ForeignFunctionInterface #-} -module Main where - -import Data.Binary -import Data.String -import System.Environment hiding (getEnv) -import qualified Data.Map as M -import qualified Data.ByteString.Lazy as B - -import Text.Printf - -import Control.Monad - -import qualified JVM.Assembler as J -import JVM.Assembler hiding (Instruction) -import JVM.Common -import JVM.ClassFile -import JVM.Converter -import JVM.Dump - -import Foreign -import Foreign.Ptr -import Foreign.C.Types - -import Harpy -import Harpy.X86Disassembler - - -foreign import ccall "dynamic" - code_void :: FunPtr (CInt -> IO CInt) -> (CInt -> IO CInt) - -foreign import ccall "getaddr" - getaddr :: CUInt - -foreign import ccall "callertrap" - callertrap :: IO () - - -$(callDecl "callAsWord32" [t|Word32|]) - -main = do - args <- getArgs - case args of - [clspath] -> do - clsFile <- decodeFile clspath - let cp = constsPool (clsFile :: Class Pointers) - putStrLn "==== constpool: ====" - putStrLn $ showListIx $ M.elems cp - cf <- parseClassFile clspath - putStrLn "==== classfile dump: ====" - dumpClass cf - putStrLn "==== random stuff: ====" - let mainmethod = lookupMethod "main" cf -- "main|([Ljava/lang/String;)V" cf - case mainmethod of - Nothing -> putStrLn "no main found" - Just main -> - case attrByName main "Code" of - Nothing -> putStrLn "no code attr found" - Just bytecode -> do - putStrLn "woot, running now" - allocaArray 26 (\ p -> mapM_ (\ i -> poke (advancePtr p i) 0) [0..25] >> runstuff p bytecode) - _ -> error "Synopsis: dump-class File.class" - -runstuff :: Ptr Int32 -> B.ByteString -> IO () -runstuff env bytecode = do - let emittedcode = (compile (fromIntegral getaddr)) $ codeInstructions $ decodeMethod bytecode - (_, Right ((entryPtr, endOffset), disasm)) <- runCodeGen emittedcode env () - printf "entry point: 0x%08x\n" ((fromIntegral $ ptrToIntPtr entryPtr) :: Int) - - let entryFuncPtr = ((castPtrToFunPtr entryPtr) :: FunPtr (CInt -> IO CInt)) - result <- code_void entryFuncPtr (fromIntegral 0x1337) - let iresult::Int; iresult = fromIntegral result - printf "result: 0x%08x\n" iresult -- expecting (2 * 0x1337) + 0x42 = 0x26b0 - - result2 <- code_void entryFuncPtr (fromIntegral (-0x20)) - let iresult2::Int; iresult2 = fromIntegral result2 - printf "result: 0x%08x\n" iresult2 -- expecting 0x2 - - - -- s/mov ebx 0x6666/mov eax 0x6666/ - let patchit = plusPtr entryPtr 0xb - poke patchit (0xb8 :: Word8) - - result3 <- code_void entryFuncPtr (fromIntegral 0) - let iresult3::Int; iresult3 = fromIntegral result3 - printf "result: 0x%08x\n" iresult3 -- expecting 0x6666 - - printf "disasm:\n" - mapM_ (putStrLn . showAtt) disasm - - printf "patched disasm:\n" - Right newdisasm <- disassembleBlock entryPtr endOffset - mapM_ (putStrLn . showAtt) $ newdisasm - - let addr :: Int; addr = (fromIntegral getaddr :: Int) - printf "getaddr: 0x%08x\n" addr - - return () - - -entryCode :: CodeGen e s () -entryCode = do push ebp - mov ebp esp - -exitCode :: CodeGen e s () -exitCode = do mov esp ebp - pop ebp - ret - -compile :: Word32 -> [J.Instruction] -> CodeGen (Ptr Int32) s ((Ptr Word8, Int), [Instruction]) -compile trapaddr insn = do - entryCode - mapM compile_ins insn - push eax - mov ecx (trapaddr :: Word32) - call ecx - -- call trapaddr -- Y U DON'T WORK? (ask mr. gdb for help) - pop eax - exitCode - d <- disassemble - c <- getEntryPoint - end <- getCodeOffset - return ((c,end),d) - -compile_ins :: J.Instruction -> CodeGen (Ptr Int32) s () -compile_ins (BIPUSH w8) = do mov eax ((fromIntegral w8) :: Word32) -compile_ins (PUTSTATIC w16) = do add eax (Disp 8, ebp) -- add first argument to %eax -compile_ins (GETSTATIC w16) = do nop -compile_ins ICONST_2 = do mov ebx (0x6666 :: Word32) -- patch me! -compile_ins IMUL = do nop - -- mov eax (0 :: Word32) - -- jmp eax -compile_ins RETURN = do nop -compile_ins _ = do nop - --- TODO: actually this function already exists in hs-java-0.3! -lookupMethod :: B.ByteString -> Class Resolved -> Maybe (Method Resolved) -lookupMethod name cls = look (classMethods cls) - where - look [] = Nothing - look (f:fs) - | methodName f == name = Just f - | otherwise = look fs diff --git a/README b/README index 2cb413d..4bd28fb 100644 --- a/README +++ b/README @@ -1,3 +1,88 @@ -== DEPENDENCIES == -$ cabal install harpy -$ cabal install hs-java # 0.2 at the moment! +$ make +./stackoverflow_segv +entry point: 0x0a0e97e0 +welcome back +$ # however, when executing binray from shell... +$ ./stackoverflow_segv +entry point: 0x0916b7e0 +Segmentation fault (core dumped) + + + +# some information about the system +$ cat /etc/issue +Ubuntu 12.04 LTS \n \l +$ uname -a +Linux matevm-dev 3.2.0-23-generic #36-Ubuntu SMP Tue Apr 10 20:41:14 UTC 2012 i686 athlon i386 GNU/Linux +$ ghc --version +The Glorious Glasgow Haskell Compilation System, version 7.4.1 +$ gcc --version +gcc (Ubuntu/Linaro 4.6.3-1ubuntu5) 4.6.3 +Copyright (C) 2011 Free Software Foundation, Inc. +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. +$ make --version +GNU Make 3.81 +Copyright (C) 2006 Free Software Foundation, Inc. +This is free software; see the source for copying conditions. +There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A +PARTICULAR PURPOSE. + +This program built for i686-pc-linux-gnu +$ ghc-pkg list +/var/lib/ghc/package.conf.d: + Cabal-1.14.0 + array-0.4.0.0 + base-4.5.0.0 + bin-package-db-0.0.0.0 + binary-0.5.1.0 + bytestring-0.9.2.1 + containers-0.4.2.1 + deepseq-1.3.0.0 + directory-1.1.0.2 + extensible-exceptions-0.1.1.4 + filepath-1.3.0.0 + (ghc-7.4.1) + ghc-prim-0.2.0.0 + (haskell2010-1.1.0.1) + (haskell98-2.0.0.1) + hoopl-3.8.7.3 + hpc-0.5.1.1 + integer-gmp-0.4.0.0 + old-locale-1.0.0.4 + old-time-1.1.0.0 + pretty-1.1.1.0 + process-1.1.0.1 + rts-1.0 + template-haskell-2.7.0.0 + time-1.4 + unix-2.5.1.0 + +/home/lewurm/.ghc/i386-linux-7.4.1/package.conf.d: + HUnit-1.2.4.2 + MissingH-1.1.1.0 + QuickCheck-2.4.2 + binary-state-0.1.1 + control-monad-exception-0.10.2 + data-binary-ieee754-0.4.2.1 + disassembler-0.1.0.1 + failure-0.2.0.1 + ghc-paths-0.1.0.8 + harpy-0.4.3.0 + haskell-src-1.0.1.5 + heap-1.0.0 + hs-java-0.2 + hslogger-1.1.5 + monadloc-0.6 + mtl-1.1.1.1 + mtl-2.1.1 + network-2.3.0.13 + parsec-2.1.0.1 + plugins-1.5.2.1 + random-1.0.1.1 + regex-base-0.93.2 + regex-compat-0.95.1 + regex-posix-0.95.1 + syb-0.3.6.1 + transformers-0.3.0.0 + utf8-string-0.3.7 diff --git a/Test.java b/Test.java deleted file mode 100644 index 6f557c3..0000000 --- a/Test.java +++ /dev/null @@ -1,9 +0,0 @@ -public class Test { - private static int foo; - private static int bar; - - public static void main(String [] args) { - foo = 0x42; - bar = 2 * foo; - } -} diff --git a/trap.c b/trap.c deleted file mode 100644 index a1e5ddc..0000000 --- a/trap.c +++ /dev/null @@ -1,17 +0,0 @@ -#include - -void callertrap(void) -{ - char buf[5]; - unsigned int *ptr = (unsigned int) (buf + 1); - - printf("callertrap by 0x%08x\n", *(ptr + 4)); - /* TODO: - * call magic haskell function - * with environment information */ -} - -unsigned int getaddr(void) -{ - return (unsigned int) callertrap; -} -- 2.25.1