Notes on hacking with haskell

11-23-2007, 10:31 PM

I am researching doing the things grimoire does in a language less nightmarish than C++.

I am using GHC 6.8.1 and nasm 0.98.39.

Injectable DLLs
First you need a stub DllMain

Code:

// dllmain.c
// compile with ghc -c dllmain.c
#include <windows.h>
#include <Rts.h>

#include <stdio.h>

extern void __stginit_ListFile(void);
static char* args[] = { "ghcDll", NULL };
extern int hsMain(void);

FILE *out;

DWORD __stdcall WorkThread(void* param)
{
	return hsMain();
}

BOOL __stdcall DllMain(HMODULE module, DWORD reason, void* reserved)
{
    if (reason == DLL_PROCESS_ATTACH) {
	DisableThreadLibraryCalls(module);
	startupHaskell(1, args, __stginit_ListFile);
	CloseHandle(CreateThread(NULL,16384,WorkThread,NULL,0,NULL));
    }
    return TRUE;
}

Each module in the haskell code into which you call directly needs a __stginit_ModuleName. For testing this, the executable you inject into needs some life time since we are in non deterministic multithreading land. In order to not block you have to createthread from the start gate.

Your haskell code needs the foreign function interface. The callin listed in dllmain.c is hsMain.

Code:

-- listfile.hs
-- compile with del listfile.o; ghc -shared -o listfile.dll listfile.hs dllmain.o
{-# LANGUAGE ForeignFunctionInterface #-}
foreign export ccall hsMain :: IO Int
hsMain :: IO Int
hsMain = return 0 -- your main here

foreign export ccall fun creates a stub for calling fun from C which you can link to with an extern declaration.
Marshalling values
Grimoire has lots of assembly snippets for patching warcraft. Ideally we would write these in haskell with a library like Harpy, but Harpy isn't very stable and creates MB of executable. So we continue to use nasm. To import a C function:

Code:

foreign import ccall unsafe "LFPatch" lfpatch :: Addr

This has to be a function! Note that we declare it as a function as C too, but this time we actually call it to marshal the value across. To go from haskell to C we have to do the same thing

Code:

foreign export ccall get_sFileOpenFileEx :: IO Addr
get_sFileOpenFileEx :: IO Addr
get_sFileOpenFileEx = readIORef glob_sFileOpenFileEx

Global state
Since we can't construct foreign exports by currying, we need global variables to fake it. We do this with a horrible hack

Code:

{-# NOINLINE genglob #-}
genglob :: a -> IORef a
genglob = unsafePerformIO . newIORef

The argument to genglob is the initial value of the global. We can then read and write to it with readIORef and writeIORef when we're in the IO monad.

Pointers
We need to fiddle around with warcraft bits. We have

Code:

peek :: Storable a => Ptr a -> IO a
poke :: Storable a => Ptr a -> a -> IO ()
pokeElemOff :: Storable a => Ptr a -> Int -> a -> IO ()
peekElemOff :: Storable a => Ptr a -> Int -> IO a

To patch we can write patchbytes the same way we do in C++

Code:

patchbytes :: Addr -> Addr -> DWORD -> IO ()
patchbytes dest src len = do
	old <- virtualProtect dest len pAGE_READWRITE
	moveMemory dest src len
	virtualProtect dest len old

Structs
We want instances of Storable for weird structs. Unfortunately ghc can't derive them automatically, although maybe a tool like c2hs can? For now I use hsc2hs.

Code:

//foo.h
#pragma pack(1)
typedef struct {
	int x;
	char c;
	int y;
} Foo;
#pragma pack()

void print_foo(const Foo *);

Code:

//foo.c
#include "foo.h"
#include <stdio.h>
#include <stdlib.h>

void print_foo(const Foo *f)
{
	printf("%s %d\n",__FUNCTION__,sizeof(Foo));
	printf("f->x: %d\n",f->x);
	printf("f->c: %d\n",f->c);
	printf("f->y: %d\n",f->y);
}

Foo *makefoo()
{
	Foo *f = (Foo *)malloc(sizeof(Foo));
	f->x = 10;
	f->c = 15;
	f->y = 20;
}

Code:

-- struct.hsc
-- compile with hsc2hs struct.hsc && ghc --make struct.hs foo.c
{-# LANGUAGE ForeignFunctionInterface #-}
module Main where
import Foreign
import Foreign.C.Types

#include "foo.h"

data Bar = Bar { x :: Int, c :: Word8, y :: Int } -- haskell record for Foo

foreign import ccall "static foo.h print_foo" f_print_foo :: Ptr Bar -> IO () -- static does compiletime type check presumably
foreign import ccall "makefoo" f_makefoo :: IO (Ptr Bar)

instance Storable Bar where
	sizeOf _ = (#size Foo)
	alignment _ = alignment (undefined :: Word8)
	peek ptr = do
		x' <- (#peek Foo, x) ptr
		c' <- (#peek Foo, c) ptr
		y' <- (#peek Foo, y) ptr
		return Bar { x=x', c=c', y=y' }
	poke ptr (Bar x' c' y') = do
		(#poke Foo, x) ptr x'
		(#poke Foo, c) ptr c'
		(#poke Foo, y) ptr y'

printFoo b = with b f_print_foo

foo_setx :: Ptr Bar -> Int -> IO ()
foo_setx foo x' = (#poke Foo, x) foo x'

main = do
	x <- f_makefoo 	-- fetch Ptr Bar from C land
	b <- peek x	-- read Ptr to construct a haskell Bar
	printFoo b	-- allocate temporary to send a ptr back to C
	poke x $ Bar 20 30 40	-- write out a new bar to old Ptr location
	foo_setx x 15	-- call C function on old Ptr
	f_print_foo x	-- and again!
	
-- there may be a better technique using ByteString and Data.Binary
-- Data.Binary can automatically derive instances, apparently.

Sample DLL
As a particularly simple example I translated the listfile generator to haskell. This does not demonstrate struct marshalling.

Code:

--listfile.hs
{-# LANGUAGE ForeignFunctionInterface #-}

{-
 - Implementation of listfile dump in haskell
 -}

module ListFile where
import System.IO
import System.Win32.Types
import Foreign
import Foreign.C.String
import Data.IORef
import Control.Exception as E
import Hacklib

-- C imports
foreign import ccall unsafe "LFPatch" lfpatch :: Addr
foreign import ccall unsafe "LFPatchEnd" lfpatchend :: Addr
lfpatchsize = (castPtrToUINT lfpatchend) - (castPtrToUINT lfpatch)

-- Global variables
glob_out = openglobf "logs\\listfile.txt"
glob_sFileOpenFileEx = nullglob

-- actions
hsMain_ :: IO Int
hsMain_ = do
	inithacklib "logs\\listfile_log.txt"
	readIORef glob_out >>= hFlush 		-- force early initialization
	lib <- waitformodule "storm.dll"
	sFileOpenFileEx <- getProc lib "sFileOpenFileEx" $ castUINTToPtr 268
	writeIORef glob_sFileOpenFileEx sFileOpenFileEx
	sFileGetArchiveName <- getProc lib "sFileGetArchiveName" $ castUINTToPtr 275
	patchbytes sFileOpenFileEx lfpatch lfpatchsize
	logmsg "Listfile loading complete."
	return 1

-- exports
-- callbacks embedded into warcraft
foreign export ccall get_sFileOpenFileEx :: IO Addr
get_sFileOpenFileEx :: IO Addr
get_sFileOpenFileEx = readIORef glob_sFileOpenFileEx

foreign export ccall lfHandler :: Int -> CString -> IO ()
lfHandler :: Int -> CString -> IO ()
lfHandler mpq fn = do
	s <- peekCString fn
	out <- readIORef glob_out
	hPutStrLn out s

-- for dllMain
foreign export ccall hsMain :: IO Int
hsMain :: IO Int
hsMain = E.catch hsMain_ (\e -> logmsg (show e) >> return 0)

Code:

--hacklib.hs
{-
 - Common functions for hacking
 -}

module Hacklib(inithacklib,openglobf,nullglob,waitformodule,patchbytes,getProc,logmsg) where
import System.IO
import System.IO.Unsafe

import Data.IORef

import Foreign.Ptr

import System.Win32.Mem
import System.Win32.Process
import System.Win32.DLL
import System.Win32.Types

-- Global variable construction.  Unholy evil.
{-# NOINLINE genglob #-}
genglob :: a -> IORef a
genglob = unsafePerformIO . newIORef

{-# NOINLINE openglobf #-}
openglobf :: String -> IORef Handle
openglobf fn = genglob . unsafePerformIO . openf

openf :: String -> IO Handle
openf fn = do 
	f <- openFile fn WriteMode
	hSetBuffering f LineBuffering
	return f

nullglob :: IORef (Ptr a)
nullglob = genglob nullPtr

-- Miscellaneous Actions
waitformodule :: String -> IO HMODULE
waitformodule x = do
	hmodule <- getModuleHandle (Just x)
	if hmodule == nullPtr then sleep 1 >> waitformodule x else return hmodule

patchbytes :: Addr -> Addr -> DWORD -> IO ()
patchbytes dest src len = do
	old <- virtualProtect dest len pAGE_READWRITE
	moveMemory dest src len
	old2 <- virtualProtect dest len old
	return ()

erronnull :: Ptr a -> String -> IO ()
erronnull p n = if p == nullPtr then error ("couldn't open "++n) else return ()

getProc :: HMODULE -> String -> LPCSTR -> IO Addr
getProc lib print_name get_name = do
	addr <- c_GetProcAddress lib get_name
	erronnull addr print_name
	logmsg $ print_name++": "++show addr
	return addr

-- Logging engine
glob_log :: IORef Handle
glob_log = genglob stdout

logmsg :: String -> IO ()
logmsg s = do
	f <- readIORef glob_log
	hPutStrLn f s

inithacklib :: String -> IO ()
inithacklib fn = do
	f <- openf fn
	writeIORef glob_log f

Code:

;lfasm.asm
[bits 32]

global _LFPatch
global _LFPatchEnd

extern _get_sFileOpenFileEx
extern _lfHandler	;;cdecl of two args

section .text
_LFPatch:
	mov eax, _XLFPatch
	ret
	align 16
_LFPatchEnd:
	mov eax, _XLFPatchEnd
	ret
	align 16

_XLFPatch:	;;either way it's 7 bytes
	mov eax,_LFHook	
	jmp eax
	nop	;;make it 9 bytes
	nop
_XLFPatchEnd:
	align 16
_LFHook:
	mov eax,[esp+8]
	push eax
	mov eax,[esp+8]
	push eax
	call _lfHandler
	add esp,8

	push ebp	;1B			;do overwritten work
	mov ebp,esp	;2B
	sub esp,0x10c	;6B

	call _get_sFileOpenFileEx
	;mov eax,[_SFileOpenFileEx]		;return to overwritten function
	lea eax,[eax+_XLFPatchEnd-_XLFPatch]
	jmp eax

_LFHookEnd:
	align 16

Code:

#Makefile
all: listfile.dll

listfile.dll: hacklib.o listfile.hs dllmain.o lfasm.o
	del listfile.o
	ghc -shared -o listfile.dll listfile.hs hacklib.o dllmain.o lfasm.o -package Win32 -package mtl

hacklib.o: hacklib.hs
	ghc -c hacklib.hs

dllmain.o: dllmain.c
	ghc -c dllmain.c -Wall

lfasm.o: lfasm.asm
	nasmw -o lfasm.o -f win32 lfasm.asm

clean:
	del *.o listfile.dll *.a listfile_stub.*

This provides the IO monad skin for writing more complex hacks.

11-29-2007, 08:56 PM	#2
Oglog	Ah haskell, I only ever used that for compiling the whitespace compiler. Keep up the good work with Grimoire.

12-03-2007, 01:35 AM	#3
Mapz_Maker	Hmm, nightmarish? C++ = Good Windows GUI && C++ = Nightmare * 2349238423487929263428934623864367 I see your point. (my opinion, just stick with the console)