convert git config reading to use hGetLineUntilExitOrEOF

Much nicer than the old hack of waiting for a few seconds for stderr to be read.

diff --git a/Git/Config.hs b/Git/Config.hs
index ed4e661bb7862411f907cd7c39d7fd39e6833952..20ddf790d84519a4207075e5570bac9564ec2048 100644 (file)
--- 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 75e9282a84711a34c0ce90f6e3a054664fe57751..73c5b7b50c5d25cee4b82488f46f618ac3c6c407 100644 (file)
--- 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