From 66497d39b3bbbc564c8f521501dc6bf8b7ad2f68 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 19 Nov 2020 15:34:26 -0400
Subject: [PATCH] convert git config reading to use hGetLineUntilExitOrEOF

Much nicer than the old hack of waiting for a few seconds for stderr to be read.
---
 Git/Config.hs    | 22 +++++++++-------------
 Remote/GCrypt.hs |  2 +-
 2 files changed, 10 insertions(+), 14 deletions(-)

diff --git a/Git/Config.hs b/Git/Config.hs
index ed4e661bb7..20ddf790d8 100644
--- a/Git/Config.hs
+++ b/Git/Config.hs
@@ -22,7 +22,6 @@ import Git.Types
 import qualified Git.Command
 import qualified Git.Construct
 import Utility.UserInfo
-import Utility.ThreadScheduler
 
 {- Returns a single git config setting, or a fallback value if not set. -}
 get :: ConfigKey -> ConfigValue -> Repo -> ConfigValue
@@ -211,8 +210,8 @@ coreBare = "core.bare"
 
 {- Runs a command to get the configuration of a repo,
  - and returns a repo populated with the configuration, as well as the raw
- - output and standard error of the command. -}
-fromPipe :: Repo -> String -> [CommandParam] -> ConfigStyle -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
+ - output and the standard error of the command. -}
+fromPipe :: Repo -> String -> [CommandParam] -> ConfigStyle -> IO (Either SomeException (Repo, S.ByteString, String))
 fromPipe r cmd params st = tryNonAsync $ withCreateProcess p go
   where
 	p = (proc cmd $ toCommand params)
@@ -220,24 +219,21 @@ fromPipe r cmd params st = tryNonAsync $ withCreateProcess p go
 		, std_err = CreatePipe
 		}
 	go _ (Just hout) (Just herr) pid =
-		withAsync (S.hGetContents herr) $ \errreader -> do
+		withAsync (getstderr pid herr []) $ \errreader -> do
 			val <- S.hGetContents hout
-			-- In case the process exits while something else,
-			-- like a background process, keeps the stderr handle
-			-- open, don't block forever waiting for stderr.
-			-- A few seconds after finishing reading stdout
-			-- should get any error message.
-			err <- either id id <$> 
-				wait errreader
-					`race` (threadDelaySeconds (Seconds 2) >> return mempty)
+			err <- wait errreader
 			forceSuccessProcess p pid
 			r' <- store val st r
 			return (r', val, err)
 	go _ _ _ _ = error "internal"
 
+	getstderr pid herr c = hGetLineUntilExitOrEOF pid herr >>= \case
+		Just l -> getstderr pid herr (l:c)
+		Nothing -> return (unlines (reverse c))
+
 {- Reads git config from a specified file and returns the repo populated
  - with the configuration. -}
-fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString, S.ByteString))
+fromFile :: Repo -> FilePath -> IO (Either SomeException (Repo, S.ByteString, String))
 fromFile r f = fromPipe r "git"
 	[ Param "config"
 	, Param "--file"
diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs
index 75e9282a84..73c5b7b50c 100644
--- a/Remote/GCrypt.hs
+++ b/Remote/GCrypt.hs
@@ -487,7 +487,7 @@ getGCryptId fast r gc
 	extract Nothing = (Nothing, r)
 	extract (Just r') = (fromConfigValue <$> Git.Config.getMaybe coreGCryptId r', r')
 
-getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, S.ByteString, S.ByteString))
+getConfigViaRsync :: Git.Repo -> RemoteGitConfig -> Annex (Either SomeException (Git.Repo, S.ByteString, String))
 getConfigViaRsync r gc = do
 	(rsynctransport, rsyncurl, _) <- rsyncTransport r gc
 	opts <- rsynctransport
-- 
2.30.2