summaryrefslogtreecommitdiff
path: root/Utility
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-04-06 20:18:57 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-04-06 20:20:52 -0400
commit466a2c31be0f662c3c93dd54867d2a969e01714e (patch)
tree8ec40ec574bf752ce4fa79bc94f9ca805e594641 /Utility
parentaf8e2e2f1db15d6cd5951f8a5ba7eafda93df519 (diff)
bring back --quiet filtering of stdout and stderr, with deadlock fixed
I don't quite understand the cause of the deadlock. It only occurred when git-annex-shell transferinfo was being spawned over ssh to feed download transfer progress back. And if I removed this line from feedprogressback, the deadlock didn't occur: bytes <- readSV v The problem was not a leaked FD, as far as I could see. So what was it? I don't know. Anyway, this is a nice clean implementation, that avoids the deadlock. Just fork off the async threads to handle filtering the stdout and stderr, and let them clean up their handles whenever they decide to exit. I've verified that the handles do get promptly closed, although a little later than I would expect. Presumably that "little later" is what was making waiting on the threads deadlock. Despite the late exit, the last line of stdout and stderr appears where I'd want it to, so I guess this is ok..
Diffstat (limited to 'Utility')
-rw-r--r--Utility/Metered.hs51
1 files changed, 31 insertions, 20 deletions
diff --git a/Utility/Metered.hs b/Utility/Metered.hs
index 9a0b726a7..f94b5d121 100644
--- a/Utility/Metered.hs
+++ b/Utility/Metered.hs
@@ -164,19 +164,15 @@ type ProgressParser = String -> (Maybe BytesProcessed, String)
- to update a meter.
-}
commandMeter :: ProgressParser -> OutputHandler -> MeterUpdate -> FilePath -> [CommandParam] -> IO Bool
-commandMeter progressparser oh meterupdate cmd params = catchBoolIO $
- withHandle StdoutHandle createProcessSuccess p $ \outh -> do
- -- ep <- async $ handlestderr errh
- op <- async $ feedprogress zeroBytesProcessed [] outh
- -- wait ep
- wait op
+commandMeter progressparser oh meterupdate cmd params =
+ outputFilter cmd params Nothing
+ (feedprogress zeroBytesProcessed [])
+ handlestderr
where
- p = proc cmd (toCommand params)
-
feedprogress prev buf h = do
b <- S.hGetSome h 80
if S.null b
- then return True
+ then return ()
else do
unless (quietMode oh) $ do
S.hPut stdout b
@@ -203,18 +199,13 @@ demeterCommand :: OutputHandler -> FilePath -> [CommandParam] -> IO Bool
demeterCommand oh cmd params = demeterCommandEnv oh cmd params Nothing
demeterCommandEnv :: OutputHandler -> FilePath -> [CommandParam] -> Maybe [(String, String)] -> IO Bool
-demeterCommandEnv oh cmd params environ = catchBoolIO $
- withHandle StdoutHandle createProcessSuccess p $ \outh -> do
- -- ep <- async $ avoidProgress True errh $ stderrHandler oh
- op <- async $ avoidProgress True outh $ \l ->
- unless (quietMode oh) $
- putStrLn l
- -- wait ep
- wait op
- return True
+demeterCommandEnv oh cmd params environ = outputFilter cmd params environ
+ (\outh -> avoidProgress True outh stdouthandler)
+ (\errh -> avoidProgress True errh $ stderrHandler oh)
where
- p = (proc cmd (toCommand params))
- { env = environ }
+ stdouthandler l =
+ unless (quietMode oh) $
+ putStrLn l
{- To suppress progress output, while displaying other messages,
- filter out lines that contain \r (typically used to reset to the
@@ -226,3 +217,23 @@ avoidProgress doavoid h emitter = unlessM (hIsEOF h) $ do
unless (doavoid && '\r' `elem` s) $
emitter s
avoidProgress doavoid h emitter
+
+outputFilter
+ :: FilePath
+ -> [CommandParam]
+ -> Maybe [(String, String)]
+ -> (Handle -> IO ())
+ -> (Handle -> IO ())
+ -> IO Bool
+outputFilter cmd params environ outfilter errfilter = catchBoolIO $ do
+ (_, Just outh, Just errh, pid) <- createProcess p
+ { std_out = CreatePipe
+ , std_err = CreatePipe
+ }
+ void $ async $ tryIO (outfilter outh) >> hClose outh
+ void $ async $ tryIO (errfilter errh) >> hClose errh
+ ret <- checkSuccessProcess pid
+ return ret
+ where
+ p = (proc cmd (toCommand params))
+ { env = environ }