module System.Linux.Ptrace.Syscall (
RemotePtr(),
castRemotePtr,
ptrace_traceme,
ptrace_attach,
ptrace_peektext, ptrace_peekdata, ptrace_peekuser,
ptrace_poketext, ptrace_pokedata, ptrace_pokeuser,
ptrace_cont, ptrace_syscall, ptrace_singlestep, ptrace_detach,
ptrace_kill,
ptrace_getregs,
ptrace_setregs,
--ptrace_getfpregs,
--ptrace_setfpregs,
ptrace_setoptions,
ptrace_geteventmsg,
--ptrace_getsiginfo,
--ptrace_setsiginfo
) where
import Foreign
import Foreign.C
import Data.Bits
import Data.List (foldl')
import Data.Maybe
import System.Linux.Ptrace.Types
import System.Posix.Signals (Signal, nullSignal)
import System.Posix.Types (CPid)
import System.Process
newtype RemotePtr a = RemotePtr WordPtr deriving (Eq, Ord, Show, Num, Bits, Storable, Enum, Real, Integral)
castRemotePtr (RemotePtr a) = RemotePtr a
type DataArg = WordPtr
foreign import ccall unsafe "ptrace" c_ptrace :: CInt -> CPid -> RemotePtr a -> DataArg -> IO CLong
data Event = EventFork | EventVFork | EventClone | EventExec | EventVForkDone | EventExit deriving (Eq, Show)
event :: CLong -> Event
event 1 = EventFork
event 2 = EventVFork
event 3 = EventClone
event 4 = EventExec
event 5 = EventVForkDone
event 6 = EventExit
event n = error $ "ptrace: unexpected event code " ++ show n
handlePtraceResult :: IO CLong -> IO ()
handlePtraceResult = throwErrnoIfMinus1_ "ptrace"
throwErrnoIfSet :: IO a -> IO a
throwErrnoIfSet act = do
resetErrno
r <- act
e <- getErrno
if e /= eOK then throwErrno "ptrace" else return r
ptrace4 n pid addr data_ = handlePtraceResult $ c_ptrace n pid addr data_
ptrace2 n pid = ptrace4 n pid 0 0
ptrace1 n = ptrace2 n 0
ptracePeek n pid addr = fromIntegral `fmap` (throwErrnoIfSet $ c_ptrace n pid addr 0)
ptracePoke n pid addr val = ptrace4 n pid addr (fromIntegral val)
ptraceGet n pid = alloca (\ptr -> ptrace4 n pid 0 (ptrToWordPtr ptr) >> peek ptr)
ptraceSet n pid val = alloca (\ptr -> poke ptr val >> ptrace4 n pid 0 (ptrToWordPtr ptr))
ptraceResume n pid sig = ptrace4 n pid 0 (maybe 0 fromIntegral sig)
ptrace_traceme :: IO ()
ptrace_traceme = ptrace1 0
ptrace_attach :: CPid -> IO ()
ptrace_attach = ptrace2 16
ptrace_peektext, ptrace_peekdata, ptrace_peekuser ::
CPid -> RemotePtr Word -> IO Word
ptrace_peektext = ptracePeek 1
ptrace_peekdata = ptracePeek 2
ptrace_peekuser = ptracePeek 3
ptrace_poketext, ptrace_pokedata, ptrace_pokeuser ::
CPid -> RemotePtr Word -> Word -> IO ()
ptrace_poketext = ptracePoke 4
ptrace_pokedata = ptracePoke 5
ptrace_pokeuser = ptracePoke 6
ptrace_cont, ptrace_syscall, ptrace_singlestep, ptrace_detach ::
CPid -> Maybe Signal -> IO ()
ptrace_cont = ptraceResume 7
ptrace_syscall = ptraceResume 24
ptrace_singlestep = ptraceResume 9
ptrace_detach = ptraceResume 17
ptrace_kill :: CPid -> IO ()
ptrace_kill pid = ptrace2 8 pid
ptrace_getregs :: CPid -> IO Regs
ptrace_getregs pid | sizeOf (0 :: RemotePtr ()) == 4 = X86 `fmap` ptraceGet 12 pid
| sizeOf (0 :: RemotePtr ()) == 8 = X86_64 `fmap` ptraceGet 12 pid
ptrace_setregs :: CPid -> Regs -> IO ()
ptrace_setregs pid (X86 regs) = ptraceSet 13 pid regs
ptrace_setregs pid (X86_64 regs) = ptraceSet 13 pid regs
ptrace_getfpregs :: CPid -> IO Cuser_fpregs_struct
ptrace_getfpregs pid = ptraceGet 14 pid
ptrace_setfpregs :: CPid -> Cuser_fpregs_struct -> IO ()
ptrace_setfpregs pid regs = ptraceSet 15 pid regs
data Option = TraceSysGood | TraceFork | TraceVFork | TraceClone | TraceExec | TraceVForkDone | TraceExit
optionCode :: Option -> DataArg
optionCode TraceSysGood = 0x01
optionCode TraceFork = 0x02
optionCode TraceVFork = 0x04
optionCode TraceClone = 0x08
optionCode TraceExec = 0x10
optionCode TraceVForkDone = 0x20
optionCode TraceExit = 0x40
optionsCode :: [Option] -> DataArg
optionsCode = foldl' (.|.) 0 . map optionCode
ptrace_setoptions :: CPid -> [Option] -> IO ()
ptrace_setoptions pid opts = ptrace4 0x4200 pid 0 (optionsCode opts)
ptrace_geteventmsg :: CPid -> IO CULong
ptrace_geteventmsg pid = ptraceGet 0x4201 pid
ptrace_getsiginfo :: CPid -> IO Csiginfo_t
ptrace_getsiginfo pid = ptraceGet 0x4202 pid
ptrace_setsiginfo :: CPid -> Csiginfo_t -> IO ()
ptrace_setsiginfo pid siginfo = ptraceSet 0x4203 pid siginfo