From cf9eb1f6d1dd9a5a52a9604bff60dcbb766825fe Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 13 Apr 2017 15:45:42 -0400
Subject: 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.
---
 debug-me.hs | 25 ++++++-------------------
 1 file changed, 6 insertions(+), 19 deletions(-)

(limited to 'debug-me.hs')

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
-- 
cgit v1.2.3