diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-05-04 15:16:04 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-05-04 15:16:04 -0400 |
commit | 18e70a49274033d0598fcdfe830f80b0cc3552f0 (patch) | |
tree | 435dede3375593cb84453197136c480f2102e749 | |
parent | 62b488cb62a52eac92e6d37932a773ec138a5a2b (diff) | |
download | debug-me-18e70a49274033d0598fcdfe830f80b0cc3552f0.tar.gz |
--replay: make Space advance to next output
This commit was sponsored by John Peloquin on Patreon.
-rw-r--r-- | Pty.hs | 65 | ||||
-rw-r--r-- | Replay.hs | 16 | ||||
-rw-r--r-- | debug-me.1 | 4 |
3 files changed, 58 insertions, 27 deletions
@@ -3,7 +3,15 @@ - Licensed under the GNU AGPL version 3 or higher. -} -module Pty (Pty, runWithPty, readPty, writePty, inRawMode) where +module Pty ( + Pty, + runWithPty, + readPty, + writePty, + inRawMode, + withoutEcho, + withTerminalAttributes, +) where import System.Posix import System.Posix.Pty @@ -30,7 +38,7 @@ runWithPty cmd params a = bracket setup cleanup go -- Set the pty's terminal attributes to the same ones that -- the outer terminal had. System.Posix.Pty.setTerminalAttributes p as Immediately - setRawMode as + System.Posix.setTerminalAttributes stdInput (setRawMode as) Immediately return (p, ph, as) cleanup (p, ph, as) = do -- Needed in case the provided action throws an exception @@ -46,33 +54,40 @@ runWithPty cmd params a = bracket setup cleanup go Nothing -> return () Just sz -> resizePty p (Console.width sz, Console.height sz) -inRawMode :: IO a -> IO a -inRawMode a = bracket setup cleanup go +withTerminalAttributes :: (TerminalAttributes -> TerminalAttributes) -> IO a -> IO a +withTerminalAttributes f a = bracket setup cleanup go where setup = do as <- System.Posix.getTerminalAttributes stdInput - setRawMode as + System.Posix.setTerminalAttributes stdInput (f as) Immediately return as cleanup as = System.Posix.setTerminalAttributes stdInput as Immediately go _ = a --- This is similar to cfmakeraw(3). -setRawMode :: TerminalAttributes -> IO () -setRawMode as = do - let as' = as - `withoutMode` IgnoreBreak - `withoutMode` InterruptOnBreak - `withoutMode` CheckParity - `withoutMode` StripHighBit - `withoutMode` MapLFtoCR - `withoutMode` IgnoreCR - `withoutMode` MapCRtoLF - `withoutMode` StartStopOutput - `withoutMode` ProcessOutput - `withoutMode` EnableEcho - `withoutMode` EchoLF - `withoutMode` ProcessInput - `withoutMode` KeyboardInterrupts - `withoutMode` ExtendedFunctions - `withoutMode` EnableParity - System.Posix.setTerminalAttributes stdInput as' Immediately +-- | This is similar to cfmakeraw(3). +inRawMode :: IO a -> IO a +inRawMode = withTerminalAttributes setRawMode + +setRawMode :: TerminalAttributes -> TerminalAttributes +setRawMode as = as + `withoutMode` IgnoreBreak + `withoutMode` InterruptOnBreak + `withoutMode` CheckParity + `withoutMode` StripHighBit + `withoutMode` MapLFtoCR + `withoutMode` IgnoreCR + `withoutMode` MapCRtoLF + `withoutMode` StartStopOutput + `withoutMode` ProcessOutput + `withoutMode` EnableEcho + `withoutMode` EchoLF + `withoutMode` ProcessInput + `withoutMode` KeyboardInterrupts + `withoutMode` ExtendedFunctions + `withoutMode` EnableParity + +-- | Disable terminal echo. +withoutEcho :: IO a -> IO a +withoutEcho = withTerminalAttributes $ \as -> as + `withoutMode` EnableEcho + @@ -8,19 +8,24 @@ module Replay where import Types import Log import CmdLine +import Pty import qualified Data.ByteString as B import System.IO +import Control.Concurrent.Async import Control.Concurrent.Thread.Delay replay :: ReplayOpts -> IO () -replay opts = go =<< streamLog (replayLogFile opts) +replay opts = do + hSetBuffering stdin NoBuffering + withoutEcho $ go =<< streamLog (replayLogFile opts) where go [] = return () go (Right l:ls) = do case loggedMessage l of User (ActivityMessage a) -> do - realisticDelay (elapsedTime a) + _ <- realisticDelay (elapsedTime a) + `race` waitSpaceBar B.hPut stdout $ val $ seenData $ activity a hFlush stdout User (ControlMessage _) -> return () @@ -32,3 +37,10 @@ realisticDelay :: ElapsedTime -> IO () realisticDelay (ElapsedTime n) | n < 1 = return () | otherwise = delay $ ceiling $ n * 1000000 + +waitSpaceBar :: IO () +waitSpaceBar = do + c <- getChar + if c == ' ' + then return () + else waitSpaceBar @@ -68,6 +68,10 @@ until the session ends. The signature chain in the log file is verified as it is downloaded, but developer gpg signatures are not verified. .IP "--replay logfile" Replay a debug-me log file with realistic pauses. +.IP +While this is running, you can press Space to skip forward in the +recording to the next point, which is useful when there are long pauses in +the recording. .IP "--graphviz logfile" Uses graphviz to generate a visualization of a debug-me log file. .IP "--show-hashes" |