{-# 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
( PID, TID, DebugEventId, ForeignAddress
, PHANDLE, THANDLE
, ThreadInfo
, ImageInfo
, ExceptionInfo
, Exception(..)
, DebugEventInfo(..)
, DebugEvent
, debugBreak
, isDebuggerPresent
, waitForDebugEvent
, getDebugEvents
, continueDebugEvent
, debugActiveProcess
, peekProcessMemory
, readProcessMemory
, pokeProcessMemory
, withProcessMemory
, peekP
, pokeP
, suspendThread
, resumeThread
, withSuspendedThread
, getThreadContext
, setThreadContext
, useAllRegs
, withThreadContext
{-# LINE 60 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
, rax, rbx, rcx, rdx, rsi, rdi, rbp, rip, rsp
{-# LINE 62 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
, segCs, segDs, segEs, segFs, segGs
, eFlags
, dr
, setReg, getReg, modReg
, makeModThreadContext
, modifyThreadContext
, outputDebugString
) 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 142 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
pid <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 143 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
tid <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 144 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
r <- rest (code::DWORD) (plusPtr p ((16)))
{-# LINE 145 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
return ((pid,tid), r)
where
dwZero = 0 :: DWORD
wZero = 0 :: WORD
rest (1) p' = do
{-# LINE 151 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
chance <- ((\hsc_ptr -> peekByteOff hsc_ptr 152)) p'
{-# LINE 152 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p'
{-# LINE 153 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
addr <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 154 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
code <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 155 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
e <- case code::DWORD of
(3221225477) -> return $ AccessViolation False 0
{-# LINE 157 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225612) -> return ArrayBoundsExceeded
{-# LINE 158 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(2147483651) -> return Breakpoint
{-# LINE 159 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(2147483650) -> return DataTypeMisalignment
{-# LINE 160 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225613) -> return FltDenormalOperand
{-# LINE 161 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225614) -> return FltDivideByZero
{-# LINE 162 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225615) -> return FltInexactResult
{-# LINE 163 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225616) -> return FltInvalidOperation
{-# LINE 164 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225617) -> return FltOverflow
{-# LINE 165 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225618) -> return FltStackCheck
{-# LINE 166 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225619) -> return FltUnderflow
{-# LINE 167 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225501) -> return IllegalInstruction
{-# LINE 168 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225478) -> return InPageError
{-# LINE 169 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225620) -> return IntDivideByZero
{-# LINE 170 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225621) -> return IntOverflow
{-# LINE 171 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225510) -> return InvalidDisposition
{-# LINE 172 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225509) -> return NonContinuable
{-# LINE 173 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225622) -> return PrivilegedInstruction
{-# LINE 174 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(2147483652) -> return SingleStep
{-# LINE 175 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(3221225725) -> return StackOverflow
{-# LINE 176 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
_ -> return UnknownException
return $ Exception (chance/=dwZero, flags==dwZero, addr) e
rest (2) p' = do
{-# LINE 180 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
handle <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 181 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
local <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 182 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
start <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 183 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
return $ CreateThread (handle, local, start)
rest (3) p' = do
{-# LINE 186 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
file <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 187 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
proc <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 188 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
thread <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 189 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
imgbase <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p'
{-# LINE 190 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dbgoff <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p'
{-# LINE 191 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dbgsize <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) p'
{-# LINE 192 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
local <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p'
{-# LINE 193 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
start <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p'
{-# LINE 194 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
imgname <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) p'
{-# LINE 195 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
return $ CreateProcess proc
(file, imgbase, dbgoff, dbgsize, imgname)
(thread, local, start)
rest (4) p' =
{-# LINE 201 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
((\hsc_ptr -> peekByteOff hsc_ptr 0)) p' >>= return.ExitThread
{-# LINE 202 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rest (5) p' =
{-# LINE 204 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
((\hsc_ptr -> peekByteOff hsc_ptr 0)) p' >>= return.ExitProcess
{-# LINE 205 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rest (6) p' = do
{-# LINE 207 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
file <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 208 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
imgbase <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 209 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dbgoff <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 210 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dbgsize <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) p'
{-# LINE 211 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
imgname <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p'
{-# LINE 212 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
return $
LoadDll (file, imgbase, dbgoff, dbgsize, imgname)
rest (8) p' = do
{-# LINE 217 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dat <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 218 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
unicode <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 219 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
len <- ((\hsc_ptr -> peekByteOff hsc_ptr 10)) p'
{-# LINE 220 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
return $ DebugString dat (unicode/=wZero) len
rest (7) p' =
{-# LINE 223 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
((\hsc_ptr -> peekByteOff hsc_ptr 0)) p' >>= return.UnloadDll
{-# LINE 224 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rest _ _ = return UnknownDebugEvent
waitForDebugEvent :: Maybe Int -> IO (Maybe DebugEvent)
waitForDebugEvent timeout = allocaBytes ((176)) $ \buf -> do
{-# LINE 231 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
res <- c_WaitForDebugEvent buf $ maybe (4294967295) fromIntegral timeout
{-# LINE 232 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
if res
then peekDebugEvent buf >>= return.Just
else getLastError >>= \e -> case e of
(6) -> return Nothing
{-# LINE 236 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
(121) -> return Nothing
{-# LINE 237 "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 256 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
else (2147549185)
{-# LINE 257 "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 333 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
where
v = (1048603) :: DWORD
{-# LINE 335 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
withThreadContext :: THANDLE -> (Ptr a -> IO b) -> IO b
withThreadContext t act =
allocaBytes ((1232))
{-# LINE 339 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
$ \buf -> bracket_
(useAllRegs buf >> getThreadContext t buf)
(useAllRegs buf >> setThreadContext t buf)
(act buf)
{-# LINE 359 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rax, rbx, rcx, rdx :: Int
rsi, rdi :: Int
rbp, rip, rsp :: Int
rax = ((120))
{-# LINE 363 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rbx = ((144))
{-# LINE 364 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rcx = ((128))
{-# LINE 365 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rdx = ((136))
{-# LINE 366 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rsi = ((168))
{-# LINE 367 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rdi = ((176))
{-# LINE 368 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rbp = ((160))
{-# LINE 369 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rip = ((248))
{-# LINE 370 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rsp = ((152))
{-# LINE 371 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
{-# LINE 374 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segCs, segDs, segEs, segFs, segGs :: Int
segCs = ((56))
{-# LINE 377 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segDs = ((58))
{-# LINE 378 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segEs = ((60))
{-# LINE 379 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segFs = ((62))
{-# LINE 380 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segGs = ((64))
{-# LINE 381 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
eFlags :: Int
eFlags = ((68))
{-# LINE 384 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
dr :: Int -> Int
dr n = case n of
0 -> ((72))
{-# LINE 388 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
1 -> ((80))
{-# LINE 389 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
2 -> ((88))
{-# LINE 390 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
3 -> ((96))
{-# LINE 391 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
6 -> ((104))
{-# LINE 392 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
7 -> ((112))
{-# LINE 393 "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 ()