From aa2771b7615b91ba60249f6164c01dbda26c56e7 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 22 Apr 2017 00:40:37 -0400
Subject: Loop user input and output between Pty and outer Tty

---
 Role/User.hs | 22 +++++++++++++++++++---
 1 file changed, 19 insertions(+), 3 deletions(-)

(limited to 'Role/User.hs')

diff --git a/Role/User.hs b/Role/User.hs
index 5fb8897..3eb2ebc 100644
--- a/Role/User.hs
+++ b/Role/User.hs
@@ -19,7 +19,6 @@ import System.Exit
 import qualified Data.ByteString as B
 import Data.List.NonEmpty (NonEmpty(..), toList)
 import Data.Monoid
-import Data.Maybe
 import Data.Time.Clock.POSIX
 import System.IO
 import System.Environment
@@ -69,8 +68,11 @@ user starttxt p ochan ichan = withLogger "debug-me.log" $ \logger -> do
 	pk <- myPublicKey sk
 	let c = mkSigned sk $ Control (SessionKey pk)
 	initialmessage $ ControlMessage c
-	let act = mkSigned sk $ Activity (Seen (Val (starttxt <> "\r\n"))) Nothing
+	let starttxt' = starttxt <> "\r\n"
+	let act = mkSigned sk $ Activity (Seen (Val starttxt')) Nothing
 	let startmsg = ActivityMessage act
+	B.hPut stdout starttxt'
+	hFlush stdout
 	initialmessage startmsg
 	l <- mkLog (User startmsg) <$> getPOSIXTime
 	us <- newTVarIO $ UserState
@@ -80,14 +82,28 @@ user starttxt p ochan ichan = withLogger "debug-me.log" $ \logger -> do
 		}
 	_ <- sendPtyOutput p ochan us logger
 		`concurrently` sendPtyInput ichan ochan p us logger
+			`concurrently` forwardTtyInputToPty p
 	return ()
 
--- | Forward things written to the Pty out the TChan.
+-- | Forward things the user types to the Pty.
+forwardTtyInputToPty :: Pty -> IO ()
+forwardTtyInputToPty p = do
+	b <- B.hGetSome stdin 1024
+	if B.null b
+		then return ()
+		else do
+			writePty p b
+			forwardTtyInputToPty p
+
+-- | Forward things written to the Pty out the TChan, and also display
+-- it on their Tty.
 sendPtyOutput :: Pty -> TChan (Message Seen) -> TVar UserState -> Logger -> IO ()
 sendPtyOutput p ochan us logger = go
   where
 	go = do
 		b <- readPty p
+		B.hPut stdout b
+		hFlush stdout
 		now <- getPOSIXTime
 		l <- atomically $ do
 			let seen = Seen (Val b)
-- 
cgit v1.2.3