From 613455e059c5f24025e765e33dc290bc454e7696 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 19 Nov 2020 16:13:31 -0400
Subject: [PATCH] convert to use hGetLineUntilExitOrEOF

It looks to me like the old code would have already dealt with the case
of ssh starting a ssh daemon that inherits stderr and keeps it open.
The ender thread closed the handle, which would unblock the other thread
and let it exit. Using hGetLineUntilExitOrEOF makes this more explicit
that it's dealt with and simplifies the code.
---
 Remote/Helper/Ssh.hs | 33 ++++++++++++---------------------
 1 file changed, 12 insertions(+), 21 deletions(-)

diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs
index d44785897b..51774a1bf9 100644
--- a/Remote/Helper/Ssh.hs
+++ b/Remote/Helper/Ssh.hs
@@ -28,7 +28,6 @@ import qualified P2P.Annex as P2P
 
 import Control.Concurrent.STM
 import Control.Concurrent.Async
-import qualified Data.ByteString as B
 
 toRepo :: ConsumeStdin -> Git.Repo -> RemoteGitConfig -> SshCommand -> Annex (FilePath, [CommandParam])
 toRepo cs r gc remotecmd = do
@@ -272,7 +271,7 @@ openP2PSshConnection r connpool = do
 			, P2P.connIdent = P2P.ConnIdent $
 				Just $ "ssh connection " ++ show pidnum
 			}
-		stderrhandlerst <- newStderrHandler err
+		stderrhandlerst <- newStderrHandler err pid
 		runst <- P2P.mkRunState P2P.Client
 		let c = P2P.OpenConnection (runst, conn, pid, stderrhandlerst)
 		-- When the connection is successful, the remote
@@ -301,32 +300,24 @@ openP2PSshConnection r connpool = do
 		modifyTVar' connpool $
 			maybe (Just P2PSshUnsupported) Just
 
-newStderrHandler :: Handle -> IO (TVar StderrHandlerState)
-newStderrHandler errh = do
+newStderrHandler :: Handle -> ProcessHandle -> IO (TVar StderrHandlerState)
+newStderrHandler errh ph = do
 	-- stderr from git-annex-shell p2pstdio is initially discarded
 	-- because old versions don't support the command. Once it's known
 	-- to be running, this is changed to DisplayStderr.
 	v <- newTVarIO DiscardStderr
-	p <- async $ go v
-	void $ async $ ender p v
+	void $ async $ go v
 	return v
   where
 	go v = do
-		l <- B.hGetLine errh
-		atomically (readTVar v) >>= \case
-			DiscardStderr -> go v
-			DisplayStderr -> do
-				B.hPut stderr l
-				go v
-			EndStderrHandler -> return ()
-	
-	ender p v = do
-		atomically $ do
-			readTVar v >>= \case
-				EndStderrHandler -> return ()
-				_ -> retry
-		hClose errh
-		cancel p
+		hGetLineUntilExitOrEOF ph errh >>= \case
+			Nothing -> hClose errh
+			Just l -> atomically (readTVar v) >>= \case
+				DiscardStderr -> go v
+				DisplayStderr -> do
+					hPutStrLn stderr l
+					go v
+				EndStderrHandler -> hClose errh
 
 -- Runs a P2P Proto action on a remote when it supports that,
 -- otherwise the fallback action.