diff options
| -rw-r--r-- | Replay.hs | 27 | ||||
| -rw-r--r-- | Session.hs | 13 | ||||
| -rw-r--r-- | TODO | 3 | ||||
| -rw-r--r-- | debug-me.cabal | 2 | ||||
| -rw-r--r-- | debug-me.hs | 6 |
5 files changed, 43 insertions, 8 deletions
@@ -3,10 +3,29 @@ module Replay where import Types import Log import CmdLine +import Session + +import qualified Data.ByteString as B +import System.IO +import Control.Concurrent.Thread.Delay replay :: ReplayOpts -> IO () -replay opts = go =<< loadLog (replayLogFile opts) +replay opts = go Nothing =<< loadLog (replayLogFile opts) where - go [] = return () - go (l:ls) = do - go ls + go _ [] = sessionDone + go prevts (l:ls) = do + case prevts of + Nothing -> return () + Just t -> + let s = loggedTimestamp l - t + ms = s * 1000000 + in delay (ceiling ms) + + case loggedActivity l of + ActivityEntered {} -> return () + ActivitySeen a -> case activity a of + Rejected {} -> return () + Proto s -> do + B.hPut stdout (val (seenData s)) + hFlush stdout + go (Just $ loggedTimestamp l) ls diff --git a/Session.hs b/Session.hs new file mode 100644 index 0000000..e7bf674 --- /dev/null +++ b/Session.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE OverloadedStrings, RankNTypes, FlexibleContexts #-} + +module Session where + +import qualified Data.ByteString as B + +startSession :: B.ByteString +startSession = ">>> debug-me session starting" + +sessionDone :: IO () +sessionDone = do + putStrLn "" + putStrLn ">>> debug-me session is done" @@ -1,4 +1,5 @@ -* Add timings, so logs can be replayed. +* loadLog should verify the hashes (and signatures) in the log, and + refuse to use logs that are not valid proofs of a session. * potential DOS where developer sends Activity Entered that all refer back to the first Activity Seen. This requires the user side to keep a Backlog containing all later Activity Seen, so uses diff --git a/debug-me.cabal b/debug-me.cabal index 37d8357..cc34c0c 100644 --- a/debug-me.cabal +++ b/debug-me.cabal @@ -37,6 +37,7 @@ Executable debug-me , optparse-applicative (>= 0.12) , graphviz (== 2999.18.*) , time (>= 1.6) + , unbounded-delays (>= 0.1) Other-Modules: CmdLine Graphviz @@ -44,6 +45,7 @@ Executable debug-me Log Pty Replay + Session Types Val diff --git a/debug-me.hs b/debug-me.hs index 0b51878..3cc1f09 100644 --- a/debug-me.hs +++ b/debug-me.hs @@ -9,6 +9,7 @@ import CmdLine import Log import Graphviz import Replay +import Session import Control.Concurrent import Control.Concurrent.Async @@ -32,9 +33,8 @@ main = do test :: IO () test = do - exitstatus <- go ">>> debug-me session starting" - putStrLn "" - putStrLn ">>> debug-me session is done" + exitstatus <- go startSession + sessionDone exitWith exitstatus where go startmsg = runWithPty "dash" [] $ \(p, ph) -> do |