mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

fix stall detection to actually work when fully stalled

Browse source 
When fully stalled, the progress bar doesn't update, so waiting on a
MVar would block forever. There's no need to wait anyway, just wake up
after sleeping the configured period and check the current value.

Luckily Viasat makes it really easy for me to notice this kind of
mistake, by stalling long TCP connections frequently.
This commit is contained in:
Joey Hess 2020-12-11 18:26:30 -04:00
parent 3e608dfc13
commit 0d0f6d9c23
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 14 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

29
Annex/TransferrerPool.hs
View file

@ -142,7 +142,7 @@ performTransfer stalldetection level runannex r t info transferrer = do
liftIO $ sendRequest level t r liftIO $ sendRequest level t r
(associatedFile info) (associatedFile info)
(transferrerWrite transferrer) (transferrerWrite transferrer)
metervar <- liftIO $ newEmptyTMVarIO metervar <- liftIO $ newTVarIO Nothing
stalledvar <- liftIO $ newTVarIO False stalledvar <- liftIO $ newTVarIO False
tid <- liftIO $ async $ tid <- liftIO $ async $
detectStalls stalldetection metervar $ do detectStalls stalldetection metervar $ do
@ -166,32 +166,31 @@ performTransfer stalldetection level runannex r t info transferrer = do
runannex runannex
updatemeter bpv metervar (Just n) = liftIO $ do updatemeter bpv metervar (Just n) = liftIO $ do
atomically $ do atomically $ writeTVar metervar (Just n)
void $ tryTakeTMVar metervar
putTMVar metervar n
atomically $ writeTVar bpv n atomically $ writeTVar bpv n
updatemeter _bpv metervar Nothing = liftIO $ updatemeter _bpv metervar Nothing = liftIO $
atomically $ void $ tryTakeTMVar metervar atomically $ writeTVar metervar Nothing
detectStalls :: Maybe StallDetection -> TMVar BytesProcessed -> IO () -> IO () detectStalls :: Maybe StallDetection -> TVar (Maybe BytesProcessed) -> IO () -> IO ()
detectStalls Nothing _ _ = noop detectStalls Nothing _ _ = noop
detectStalls (Just (StallDetection minsz duration)) metervar onstall = go Nothing detectStalls (Just (StallDetection minsz duration)) metervar onstall = go Nothing
where where
go st = do go st = do
starttm <- getPOSIXTime starttm <- getPOSIXTime
threadDelaySeconds (Seconds (fromIntegral (durationSeconds duration))) threadDelaySeconds (Seconds (fromIntegral (durationSeconds duration)))
-- Get whatever progress value was reported most recently, or -- Get whatever progress value was reported last, if any.
-- if none were reported since last time, wait until one is v <- atomically $ fmap fromBytesProcessed
-- reported. <$> readTVar metervar
sofar <- atomically $ fromBytesProcessed <$> takeTMVar metervar let cont = go v
case st of case (st, v) of
Nothing -> go (Just sofar) (Nothing, _) -> cont
Just prev (_, Nothing) -> cont
(Just prev, Just sofar)
-- Just in case a progress meter somehow runs -- Just in case a progress meter somehow runs
-- backwards, or a second progress meter was -- backwards, or a second progress meter was
-- started and is at a smaller value than -- started and is at a smaller value than
-- the previous one. -- the previous one.
| prev > sofar -> go (Just sofar) | prev > sofar -> cont
| otherwise -> do | otherwise -> do
endtm <- getPOSIXTime endtm <- getPOSIXTime
let actualduration = endtm - starttm let actualduration = endtm - starttm
@ -200,7 +199,7 @@ detectStalls (Just (StallDetection minsz duration)) metervar onstall = go Nothin
`div` max 1 (ceiling actualduration) `div` max 1 (ceiling actualduration)
if sz < expectedsz if sz < expectedsz
then onstall then onstall
else go (Just sofar) else cont
{- Starts a new git-annex transfer process, setting up handles {- Starts a new git-annex transfer process, setting up handles
- that will be used to communicate with it. -} - that will be used to communicate with it. -}