summaryrefslogtreecommitdiff
path: root/src/Utility
diff options
context:
space:
mode:
authorJoey Hess2015-10-28 14:51:30 -0400
committerJoey Hess2015-10-28 15:06:05 -0400
commita882ac7eefa405993ba903f19c51134341ba457c (patch)
tree086e99ce1704b9ae5b44a429fcbf3d45f26edfae /src/Utility
parent77b1375d3c286ffdd531ea41440eb3f319b16061 (diff)
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.
Diffstat (limited to 'src/Utility')
-rw-r--r--src/Utility/ConcurrentOutput.hs21
1 files changed, 6 insertions, 15 deletions
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