{-# LINE 1 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
{-# LINE 2 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
{-# LANGUAGE Safe #-}
{-# LINE 6 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
module System.Win32.DebugApi where
import Control.Exception( bracket_ )
import Data.Word ( Word8, Word32 )
import Foreign ( Ptr, nullPtr, ForeignPtr, mallocForeignPtrBytes
, peekByteOff, plusPtr, allocaBytes, castPtr, poke
, withForeignPtr, Storable, sizeOf, peek, pokeByteOff )
import System.IO ( fixIO )
import System.Win32.Types ( HANDLE, BOOL, WORD, DWORD, failIf_, failWith
, getLastError, failIf, LPTSTR, withTString )
#include "windows_cconv.h"
type PID = DWORD
type TID = DWORD
type DebugEventId = (PID, TID)
type ForeignAddress = Word32
type PHANDLE = Ptr ()
type THANDLE = Ptr ()
type ThreadInfo = (THANDLE, ForeignAddress, ForeignAddress)
type ImageInfo = (HANDLE, ForeignAddress, DWORD, DWORD, ForeignAddress)
type ExceptionInfo = (Bool, Bool, ForeignAddress)
data Exception
= UnknownException
| AccessViolation Bool ForeignAddress
| ArrayBoundsExceeded
| Breakpoint
| DataTypeMisalignment
| FltDenormalOperand
| FltDivideByZero
| FltInexactResult
| FltInvalidOperation
| FltOverflow
| FltStackCheck
| FltUnderflow
| IllegalInstruction
| InPageError
| IntDivideByZero
| IntOverflow
| InvalidDisposition
| NonContinuable
| PrivilegedInstruction
| SingleStep
| StackOverflow
deriving (Show)
data DebugEventInfo
= UnknownDebugEvent
| Exception ExceptionInfo Exception
| CreateThread ThreadInfo
| CreateProcess PHANDLE ImageInfo ThreadInfo
| ExitThread TID
| ExitProcess PID
| LoadDll ImageInfo
| UnloadDll TID
| DebugString ForeignAddress Bool WORD
deriving (Show)
type DebugEvent = (DebugEventId, DebugEventInfo)
peekDebugEvent :: Ptr a -> IO DebugEvent
peekDebugEvent p = do
code <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 90 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
pid <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 91 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
tid <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 92 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
r <- rest (code::DWORD) (plusPtr p ((16)))
{-# LINE 93 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
return ((pid,tid), r)
where
dwZero = 0 :: DWORD
wZero = 0 :: WORD
rest (1) p' = do
{-# LINE 99 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
chance <- ((\hsc_ptr -> peekByteOff hsc_ptr 152)) p'
{-# LINE 100 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p'
{-# LINE 101 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 102 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
code <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 103 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
e <- case code::DWORD of
(3221225477) -> return $ AccessViolation False 0
{-# LINE 105 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225612) -> return ArrayBoundsExceeded
{-# LINE 106 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(2147483651) -> return Breakpoint
{-# LINE 107 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(2147483650) -> return DataTypeMisalignment
{-# LINE 108 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225613) -> return FltDenormalOperand
{-# LINE 109 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225614) -> return FltDivideByZero
{-# LINE 110 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225615) -> return FltInexactResult
{-# LINE 111 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225616) -> return FltInvalidOperation
{-# LINE 112 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225617) -> return FltOverflow
{-# LINE 113 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225618) -> return FltStackCheck
{-# LINE 114 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225619) -> return FltUnderflow
{-# LINE 115 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225501) -> return IllegalInstruction
{-# LINE 116 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225478) -> return InPageError
{-# LINE 117 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225620) -> return IntDivideByZero
{-# LINE 118 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225621) -> return IntOverflow
{-# LINE 119 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225510) -> return InvalidDisposition
{-# LINE 120 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225509) -> return NonContinuable
{-# LINE 121 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225622) -> return PrivilegedInstruction
{-# LINE 122 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(2147483652) -> return SingleStep
{-# LINE 123 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225725) -> return StackOverflow
{-# LINE 124 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
_ -> return UnknownException
return $ Exception (chance/=dwZero, flags==dwZero, addr) e
rest (2) p' = do
{-# LINE 128 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
handle <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 129 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
local <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 130 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
start <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 131 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
return $ CreateThread (handle, local, start)
rest (3) p' = do
{-# LINE 134 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
file <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 135 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
proc <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 136 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
thread <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 137 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
imgbase <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p'
{-# LINE 138 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dbgoff <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p'
{-# LINE 139 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dbgsize <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) p'
{-# LINE 140 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
local <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p'
{-# LINE 141 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
start <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p'
{-# LINE 142 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
imgname <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) p'
{-# LINE 143 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
return $ CreateProcess proc
(file, imgbase, dbgoff, dbgsize, imgname)
(thread, local, start)
rest (4) p' =
{-# LINE 149 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
((\hsc_ptr -> peekByteOff hsc_ptr 0)) p' >>= return.ExitThread
{-# LINE 150 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rest (5) p' =
{-# LINE 152 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
((\hsc_ptr -> peekByteOff hsc_ptr 0)) p' >>= return.ExitProcess
{-# LINE 153 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rest (6) p' = do
{-# LINE 155 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
file <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 156 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
imgbase <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 157 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dbgoff <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 158 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dbgsize <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) p'
{-# LINE 159 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
imgname <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p'
{-# LINE 160 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
return $
LoadDll (file, imgbase, dbgoff, dbgsize, imgname)
rest (8) p' = do
{-# LINE 165 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dat <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 166 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
unicode <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 167 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
len <- ((\hsc_ptr -> peekByteOff hsc_ptr 10)) p'
{-# LINE 168 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
return $ DebugString dat (unicode/=wZero) len
rest (7) p' =
{-# LINE 171 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
((\hsc_ptr -> peekByteOff hsc_ptr 0)) p' >>= return.UnloadDll
{-# LINE 172 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rest _ _ = return UnknownDebugEvent
waitForDebugEvent :: Maybe Int -> IO (Maybe DebugEvent)
waitForDebugEvent timeout = allocaBytes ((176)) $ \buf -> do
{-# LINE 179 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
res <- c_WaitForDebugEvent buf $ maybe (4294967295) fromIntegral timeout
{-# LINE 180 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
if res
then peekDebugEvent buf >>= return.Just
else getLastError >>= \e -> case e of
(6) -> return Nothing
{-# LINE 184 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(121) -> return Nothing
{-# LINE 185 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
_ -> die e
where
die res = failWith "WaitForDebugEvent" res
getDebugEvents :: Int -> IO [DebugEvent]
getDebugEvents timeout = waitForDebugEvent (Just timeout) >>= getMore
where
getMore e = case e of
Nothing -> return []
Just e' -> do
rest <- waitForDebugEvent (Just 0) >>= getMore
return $ e':rest
continueDebugEvent :: DebugEventId -> Bool -> IO ()
continueDebugEvent (pid,tid) cont =
failIf_ not "ContinueDebugEvent" $ c_ContinueDebugEvent pid tid cont'
where
cont' = if cont
then (65538)
{-# LINE 204 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
else (2147549185)
{-# LINE 205 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
debugActiveProcess :: PID -> IO ()
debugActiveProcess pid =
failIf_ not "debugActiveProcess: DebugActiveProcess" $
c_DebugActiveProcess pid
peekProcessMemory :: PHANDLE -> ForeignAddress -> Int -> Ptr a -> IO ()
peekProcessMemory proc addr size buf =
failIf_ not "peekProcessMemory: ReadProcessMemory" $
c_ReadProcessMemory proc (plusPtr nullPtr $ fromIntegral addr) (castPtr buf) (fromIntegral size) nullPtr
readProcessMemory :: PHANDLE -> ForeignAddress -> Int -> IO (ForeignPtr a)
readProcessMemory proc addr size = do
res <- mallocForeignPtrBytes size
withForeignPtr res $ peekProcessMemory proc addr size
return res
pokeProcessMemory :: PHANDLE -> ForeignAddress -> Int -> Ptr a -> IO ()
pokeProcessMemory proc addr size buf =
failIf_ not "pokeProcessMemory: WriteProcessMemory" $
c_WriteProcessMemory proc (plusPtr nullPtr $ fromIntegral addr) (castPtr buf) (fromIntegral size) nullPtr
withProcessMemory :: PHANDLE -> ForeignAddress -> Int -> (Ptr a -> IO b) -> IO b
withProcessMemory proc addr size act = allocaBytes size $ \buf -> do
peekProcessMemory proc addr size buf
res <- act buf
pokeProcessMemory proc addr size buf
return res
peekP :: (Storable a) => PHANDLE -> ForeignAddress -> IO a
peekP proc addr = fixIO $ \res -> withProcessMemory proc addr (sizeOf res) peek
pokeP :: (Storable a) => PHANDLE -> ForeignAddress -> a -> IO ()
pokeP proc addr v = withProcessMemory proc addr (sizeOf v) $ \buf -> poke buf v
suspendThread :: THANDLE -> IO DWORD
suspendThread t =
failIf (==0-1) "SuspendThread" $ c_SuspendThread t
resumeThread :: THANDLE -> IO DWORD
resumeThread t =
failIf (==0-1) "ResumeThread" $ c_ResumeThread t
withSuspendedThread :: THANDLE -> IO a -> IO a
withSuspendedThread t = bracket_ (suspendThread t) (resumeThread t)
getThreadContext :: THANDLE -> Ptr a -> IO ()
getThreadContext t buf =
failIf_ not "GetThreadContext" $ c_GetThreadContext t (castPtr buf)
setThreadContext :: THANDLE -> Ptr a -> IO ()
setThreadContext t buf =
failIf_ not "SetThreadContext" $ c_SetThreadContext t (castPtr buf)
useAllRegs :: Ptr a -> IO ()
useAllRegs buf = ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) buf v
{-# LINE 281 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
where
v = (1048603) :: DWORD
{-# LINE 283 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
withThreadContext :: THANDLE -> (Ptr a -> IO b) -> IO b
withThreadContext t act =
allocaBytes ((1232))
{-# LINE 287 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
$ \buf -> bracket_
(useAllRegs buf >> getThreadContext t buf)
(useAllRegs buf >> setThreadContext t buf)
(act buf)
{-# LINE 307 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rax, rbx, rcx, rdx :: Int
rsi, rdi :: Int
rbp, rip, rsp :: Int
rax = ((120))
{-# LINE 311 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rbx = ((144))
{-# LINE 312 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rcx = ((128))
{-# LINE 313 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rdx = ((136))
{-# LINE 314 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rsi = ((168))
{-# LINE 315 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rdi = ((176))
{-# LINE 316 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rbp = ((160))
{-# LINE 317 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rip = ((248))
{-# LINE 318 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rsp = ((152))
{-# LINE 319 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
{-# LINE 322 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segCs, segDs, segEs, segFs, segGs :: Int
segCs = ((56))
{-# LINE 325 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segDs = ((58))
{-# LINE 326 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segEs = ((60))
{-# LINE 327 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segFs = ((62))
{-# LINE 328 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segGs = ((64))
{-# LINE 329 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
eFlags :: Int
eFlags = ((68))
{-# LINE 332 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dr :: Int -> Int
dr n = case n of
0 -> ((72))
{-# LINE 336 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
1 -> ((80))
{-# LINE 337 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
2 -> ((88))
{-# LINE 338 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
3 -> ((96))
{-# LINE 339 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
6 -> ((104))
{-# LINE 340 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
7 -> ((112))
{-# LINE 341 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
_ -> undefined
setReg :: Ptr a -> Int -> DWORD -> IO ()
setReg = pokeByteOff
getReg :: Ptr a -> Int -> IO DWORD
getReg = peekByteOff
modReg :: Ptr a -> Int -> (DWORD->DWORD) -> IO DWORD
modReg buf r f = do
old <- getReg buf r
setReg buf r (f old)
return old
makeModThreadContext :: [(Int, DWORD->DWORD)] -> Ptr a -> IO [DWORD]
makeModThreadContext act buf = mapM (uncurry $ modReg buf) act
modifyThreadContext :: THANDLE -> [(Int, DWORD->DWORD)] -> IO [DWORD]
modifyThreadContext t a = withThreadContext t $ makeModThreadContext a
outputDebugString :: String -> IO ()
outputDebugString s = withTString s $ \c_s -> c_OutputDebugString c_s
foreign import WINDOWS_CCONV "windows.h SuspendThread"
c_SuspendThread :: THANDLE -> IO DWORD
foreign import WINDOWS_CCONV "windows.h ResumeThread"
c_ResumeThread :: THANDLE -> IO DWORD
foreign import WINDOWS_CCONV "windows.h WaitForDebugEvent"
c_WaitForDebugEvent :: Ptr () -> DWORD -> IO BOOL
foreign import WINDOWS_CCONV "windows.h ContinueDebugEvent"
c_ContinueDebugEvent :: DWORD -> DWORD -> DWORD -> IO BOOL
foreign import WINDOWS_CCONV "windows.h DebugActiveProcess"
c_DebugActiveProcess :: DWORD -> IO Bool
foreign import WINDOWS_CCONV "windows.h ReadProcessMemory" c_ReadProcessMemory ::
PHANDLE -> Ptr () -> Ptr Word8 -> DWORD -> Ptr DWORD -> IO BOOL
foreign import WINDOWS_CCONV "windows.h WriteProcessMemory" c_WriteProcessMemory ::
PHANDLE -> Ptr () -> Ptr Word8 -> DWORD -> Ptr DWORD -> IO BOOL
foreign import WINDOWS_CCONV "windows.h GetThreadContext"
c_GetThreadContext :: THANDLE -> Ptr () -> IO BOOL
foreign import WINDOWS_CCONV "windows.h SetThreadContext"
c_SetThreadContext :: THANDLE -> Ptr () -> IO BOOL
foreign import WINDOWS_CCONV "windows.h OutputDebugStringW"
c_OutputDebugString :: LPTSTR -> IO ()
foreign import WINDOWS_CCONV "windows.h IsDebuggerPresent"
isDebuggerPresent :: IO BOOL
foreign import WINDOWS_CCONV "windows.h DebugBreak"
debugBreak :: IO ()