diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-04-13 15:45:42 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-04-13 16:02:59 -0400 |
commit | cf9eb1f6d1dd9a5a52a9604bff60dcbb766825fe (patch) | |
tree | fc15b5203e6eecedc40865569fa0be00a504ef14 /debug-me.hs | |
parent | a4a9a6b39a56db45b75da6727d5864a1af4e83ae (diff) | |
download | debug-me-cf9eb1f6d1dd9a5a52a9604bff60dcbb766825fe.tar.gz |
use posix-pty, and forward SIGWINCH
I discovered the posix-pty library while looking for a way to forward
SIGWINCH to the slave pty. It's taken care of a lot of nasty pty
handling details, so let's use it!
Unfortunately, this broke control-d exiting debug-me, which used to work
great. I think that the problem is that readPty never returns B.empty,
even on control-d. Or perhaps, posix-pty is doing something to the pty
that prevents control-d getting through.
I kept all the withoutMode code; at least withoutMode EnableEcho
is still needed.
This commit was sponsored by Jochen Bartl on Patreon.
Diffstat (limited to 'debug-me.hs')
-rw-r--r-- | debug-me.hs | 25 |
1 files changed, 6 insertions, 19 deletions
diff --git a/debug-me.hs b/debug-me.hs index 4c034b9..a5115cd 100644 --- a/debug-me.hs +++ b/debug-me.hs @@ -24,9 +24,7 @@ main = do putStrLn ">>> debug-me is exiting..." exitWith exitstatus where - go = withChildPty $ \p -> do - (Nothing, Nothing, Nothing, ph) <- createProcess $ - onPty p (proc "bash" []) + go = runWithPty "bash" [] $ \(p, ph) -> do ichan <- newTChanIO ochan <- newTChanIO dthread <- async (developer ichan ochan) @@ -38,7 +36,7 @@ main = do -- | 800 ms is about the latency to geosync orbit networkDelay :: IO () -networkDelay = threadDelay 800000 -- 150000 -- 800000 +networkDelay = threadDelay 150000 -- 800000 developer :: TChan (Activity Entered) -> TChan (Activity Seen) -> IO () developer ichan ochan = do @@ -127,17 +125,8 @@ data Backlog = Backlog (NonEmpty (HashPointer, Activity Seen)) sendPtyOutput :: Pty -> TChan (Activity Seen) -> TVar Backlog -> ProcessHandle -> IO () sendPtyOutput p ochan backlog ph = go where - Master h = ptyMaster p go = do - b <- B.hGetSome h 1024 - if b == B.empty - then do - terminateProcess ph - return () - else do - -- networkDelay - send b - send b = do + b <- readPty p atomically $ do Backlog (bl@((prevhash, _) :| _)) <- readTVar backlog let seen = Seen b @@ -151,7 +140,6 @@ sendPtyOutput p ochan backlog ph = go sendPtyInput :: TChan (Activity Entered) -> Pty -> TVar Backlog -> IO () sendPtyInput ichan p backlog = go where - Master h = ptyMaster p go = do networkDelay mb <- atomically $ do @@ -168,8 +156,7 @@ sendPtyInput ichan p backlog = go return (Left ("illegal entry", newact, bl')) case mb of Right b -> do - B.hPut h b - hFlush h + writePty p b go Left e -> do -- print e @@ -201,11 +188,11 @@ truncateBacklog (Backlog bl) _ = Backlog bl -- concatenation of all activities after that one, up to the most recent -- Seen activity. isLegal :: Activity Entered -> Backlog -> Bool -isLegal (Activity entered hp sig) (Backlog (last@(lastseenhash, _lastseen) :| bl)) +isLegal (Activity entered hp sig) (Backlog (lastseen@(lastseenhash, _lastseen) :| bl)) | lastseenhash == hp = True | B.null (echoData entered) = False -- optimisation | any (== hp) (map fst bl) = - let sincehp = reverse (last : takeWhile (\(h, _) -> h /= hp) bl) + let sincehp = reverse (lastseen : takeWhile (\(h, _) -> h /= hp) bl) in echoData entered == mconcat (map (seenData . activityContent . snd) sincehp) | otherwise = False isLegal _ _ = False |