From a882ac7eefa405993ba903f19c51134341ba457c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 28 Oct 2015 14:51:30 -0400 Subject: fix tricky race Race between 2 calls to takeOutputLock'. The first call empties the TMVar, and does some work to check it. Meanwhile, the second call could sneak in, see it was empty, and call waitlock. Since waitlock used tryTakeTMVar, that would not block it, and it would think it had the lock, filling the TMVar. In the meantime, the first call could decide it had to lock and go on to possibly cause trouble. --- src/Utility/ConcurrentOutput.hs | 21 ++++++--------------- 1 file changed, 6 insertions(+), 15 deletions(-) (limited to 'src/Utility') diff --git a/src/Utility/ConcurrentOutput.hs b/src/Utility/ConcurrentOutput.hs index 5535066f..3c072cf4 100644 --- a/src/Utility/ConcurrentOutput.hs +++ b/src/Utility/ConcurrentOutput.hs @@ -74,7 +74,7 @@ withLock a = do takeOutputLock' :: Bool -> IO Bool takeOutputLock' block = go =<< withLock tryTakeTMVar where - go Nothing = whenblock waitlock + go Nothing = whenblock waitlockchange -- Something has the lock. It may be stale, so check it. -- We must always be sure to fill the TMVar back with Just or Nothing. go (Just orig) = case orig of @@ -85,11 +85,7 @@ takeOutputLock' block = go =<< withLock tryTakeTMVar ( havelock , if block then do - hPutStr stderr "WAITFORPROCESS in lock" - hFlush stderr void $ P.waitForProcess h - hPutStr stderr "WAITFORPROCESS in lock done" - hFlush stderr havelock else do withLock (`putTMVar` orig) @@ -97,21 +93,16 @@ takeOutputLock' block = go =<< withLock tryTakeTMVar ) (Just GeneralLock) -> do withLock (`putTMVar` orig) - whenblock waitlock + whenblock waitlockchange havelock = do withLock (`putTMVar` Just GeneralLock) return True - -- Wait for current lock holder (if any) to relinquish - -- it and take the lock for ourselves. - waitlock = withLock $ \l -> do - v <- tryTakeTMVar l - case v of - Just (Just _) -> retry - _ -> do - putTMVar l (Just GeneralLock) - return True + -- Wait for the lock to change, and try again. + waitlockchange = do + void $ withLock readTMVar + takeOutputLock' block whenblock a = if block then a else return False -- cgit v1.2.3