{-# 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

-- Copyright   :  (c) Esa Ilari Vuokko, 2006

-- License     :  BSD-style (see the file LICENSE)

--

-- Maintainer  :  Esa Ilari Vuokko <ei@vuokko.info>

-- Stability   :  provisional

-- Portability :  portable

--

-- A collection of FFI declarations for using Windows DebugApi.

--

-----------------------------------------------------------------------------

module System.Win32.DebugApi
    ( PID, TID, DebugEventId, ForeignAddress
    , PHANDLE, THANDLE
    , ThreadInfo
    , ImageInfo
    , ExceptionInfo
    , Exception(..)
    , DebugEventInfo(..)
    , DebugEvent

    , debugBreak
    , isDebuggerPresent

      -- * Debug events

    , waitForDebugEvent
    , getDebugEvents
    , continueDebugEvent

      -- * Debugging another process

    , debugActiveProcess
    , peekProcessMemory
    , readProcessMemory
    , pokeProcessMemory
    , withProcessMemory
    , peekP
    , pokeP

      -- * Thread control

    , suspendThread
    , resumeThread
    , withSuspendedThread

      -- * Thread register control

    , 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

      -- * Sending debug output to another process

    , outputDebugString
    ) where

import System.Win32.DebugApi.Internal
import Control.Exception( bracket_ )
import Foreign          ( Ptr, nullPtr, ForeignPtr, mallocForeignPtrBytes
                        , peekByteOff, plusPtr, allocaBytes, castPtr, poke
                        , withForeignPtr, Storable, sizeOf, peek, pokeByteOff )
import System.IO        ( fixIO )
import System.Win32.Types   ( WORD, DWORD, failIf_, failWith
                            , getLastError, failIf, withTString )

#include "windows_cconv.h"




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)

--------------------------------------------------------------------------

-- Handling debugevents


peekDebugEvent :: Ptr a -> IO DebugEvent
peekDebugEvent p = do
    code <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p
{-# LINE 131 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    pid  <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p
{-# LINE 132 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    tid  <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p
{-# LINE 133 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    r <- rest (code::DWORD) (plusPtr p ((16)))
{-# LINE 134 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    return ((pid,tid), r)
    where
        dwZero = 0 :: DWORD
        wZero = 0 :: WORD

        rest (1) p' = do
{-# LINE 140 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            chance  <- ((\hsc_ptr -> peekByteOff hsc_ptr 152)) p'
{-# LINE 141 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            flags   <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p'
{-# LINE 142 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            addr    <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 143 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            code    <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 144 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            e <- case code::DWORD of
                (3221225477)         -> return $ AccessViolation False 0
{-# LINE 146 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225612)    -> return ArrayBoundsExceeded
{-# LINE 147 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (2147483651)               -> return Breakpoint
{-# LINE 148 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (2147483650)    -> return DataTypeMisalignment
{-# LINE 149 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225613)     -> return FltDenormalOperand
{-# LINE 150 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225614)       -> return FltDivideByZero
{-# LINE 151 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225615)       -> return FltInexactResult
{-# LINE 152 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225616)    -> return FltInvalidOperation
{-# LINE 153 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225617)             -> return FltOverflow
{-# LINE 154 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225618)          -> return FltStackCheck
{-# LINE 155 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225619)            -> return FltUnderflow
{-# LINE 156 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225501)      -> return IllegalInstruction
{-# LINE 157 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225478)            -> return InPageError
{-# LINE 158 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225620)       -> return IntDivideByZero
{-# LINE 159 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225621)             -> return IntOverflow
{-# LINE 160 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225510)      -> return InvalidDisposition
{-# LINE 161 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225509) -> return NonContinuable
{-# LINE 162 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225622)         -> return PrivilegedInstruction
{-# LINE 163 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (2147483652)              -> return SingleStep
{-# LINE 164 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                (3221225725)           -> return StackOverflow
{-# LINE 165 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
                _                                           -> return UnknownException
            return $ Exception (chance/=dwZero, flags==dwZero, addr) e

        rest (2) p' = do
{-# LINE 169 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            handle <- ((\hsc_ptr -> peekByteOff hsc_ptr 0))          p'
{-# LINE 170 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            local <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 171 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            start <- ((\hsc_ptr -> peekByteOff hsc_ptr 16))    p'
{-# LINE 172 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            return $ CreateThread (handle, local, start)

        rest (3) p' = do
{-# LINE 175 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            file    <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 176 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            proc    <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 177 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            thread  <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 178 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            imgbase <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p'
{-# LINE 179 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            dbgoff  <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p'
{-# LINE 180 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            dbgsize <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) p'
{-# LINE 181 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            local   <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) p'
{-# LINE 182 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            start   <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) p'
{-# LINE 183 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            imgname <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) p'
{-# LINE 184 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            --unicode <- (#peek CREATE_PROCESS_DEBUG_INFO, fUnicode) p'

            return $ CreateProcess proc
                        (file, imgbase, dbgoff, dbgsize, imgname) --, unicode/=wZero)

                        (thread, local, start)

        rest (4) p' =
{-# LINE 190 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p' >>= return.ExitThread
{-# LINE 191 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}

        rest (5) p' =
{-# LINE 193 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p' >>= return.ExitProcess
{-# LINE 194 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}

        rest (6) p' = do
{-# LINE 196 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            file    <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 197 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            imgbase <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 198 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            dbgoff  <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p'
{-# LINE 199 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            dbgsize <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) p'
{-# LINE 200 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            imgname <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p'
{-# LINE 201 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            --unicode <- (#peek LOAD_DLL_DEBUG_INFO, fUnicode) p'

            return $
                LoadDll (file, imgbase, dbgoff, dbgsize, imgname)--, unicode/=wZero)


        rest (8) p' = do
{-# LINE 206 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            dat     <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p'
{-# LINE 207 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            unicode <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p'
{-# LINE 208 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            len     <- ((\hsc_ptr -> peekByteOff hsc_ptr 10)) p'
{-# LINE 209 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            return $ DebugString dat (unicode/=wZero) len

        rest (7) p' =
{-# LINE 212 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p' >>= return.UnloadDll
{-# LINE 213 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}

        rest _ _ = return UnknownDebugEvent



waitForDebugEvent :: Maybe Int -> IO (Maybe DebugEvent)
waitForDebugEvent timeout = allocaBytes ((176)) $ \buf -> do
{-# LINE 220 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    res <- c_WaitForDebugEvent buf $ maybe (4294967295) fromIntegral timeout
{-# LINE 221 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    if res
        then peekDebugEvent buf >>= return.Just
        else getLastError >>= \e -> case e of
            (6)   -> return Nothing
{-# LINE 225 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            (121)      -> return Nothing
{-# LINE 226 "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 245 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
            else (2147549185)
{-# LINE 246 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}

--------------------------------------------------------------------------

-- Process control


debugActiveProcess :: PID -> IO ()
debugActiveProcess pid =
    failIf_ not "debugActiveProcess: DebugActiveProcess" $
        c_DebugActiveProcess pid

-- Windows XP

-- debugActiveProcessStop :: PID -> IO ()

-- debugActiveProcessStop pid =

--     failIf_ not "debugActiveProcessStop: DebugActiveProcessStop" $

--         c_DebugActiveProcessStop pid


--------------------------------------------------------------------------

-- Process memory


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

--------------------------------------------------------------------------

-- Thread Control


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)

--getThreadId :: THANDLE -> IO TID

--getThreadId = failIf (==0) "GetThreadId" . c_GetThreadId


--------------------------------------------------------------------------

-- Thread register control

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 322 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    where
        v = (1048603) :: DWORD
{-# LINE 324 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}

withThreadContext :: THANDLE -> (Ptr a -> IO b) -> IO b
withThreadContext t act =
    allocaBytes ((1232))
{-# LINE 328 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
        $ \buf -> bracket_
            (useAllRegs buf >> getThreadContext t buf)
            (useAllRegs buf >> setThreadContext t buf)
            (act buf)



{-# LINE 348 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rax, rbx, rcx, rdx :: Int
rsi, rdi :: Int
rbp, rip, rsp :: Int
rax = ((120))
{-# LINE 352 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rbx = ((144))
{-# LINE 353 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rcx = ((128))
{-# LINE 354 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rdx = ((136))
{-# LINE 355 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rsi = ((168))
{-# LINE 356 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rdi = ((176))
{-# LINE 357 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rbp = ((160))
{-# LINE 358 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rip = ((248))
{-# LINE 359 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
rsp = ((152))
{-# LINE 360 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}

{-# LINE 363 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}

segCs, segDs, segEs, segFs, segGs :: Int
segCs = ((56))
{-# LINE 366 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segDs = ((58))
{-# LINE 367 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segEs = ((60))
{-# LINE 368 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segFs = ((62))
{-# LINE 369 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
segGs = ((64))
{-# LINE 370 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}

eFlags :: Int
eFlags  = ((68))
{-# LINE 373 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}

dr :: Int -> Int
dr n = case n of
    0 -> ((72))
{-# LINE 377 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    1 -> ((80))
{-# LINE 378 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    2 -> ((88))
{-# LINE 379 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    3 -> ((96))
{-# LINE 380 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    6 -> ((104))
{-# LINE 381 "libraries\\Win32\\System\\Win32\\DebugApi.hsc" #-}
    7 -> ((112))
{-# LINE 382 "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

--------------------------------------------------------------------------

-- On process being debugged


outputDebugString :: String -> IO ()
outputDebugString s = withTString s $ \c_s -> c_OutputDebugString c_s