18e00500ce
Added annex.bwlimit and remote.name.annex-bwlimit config that works for git remotes and many but not all special remotes. This nearly works, at least for a git remote on the same disk. With it set to 100kb/1s, the meter displays an actual bandwidth of 128 kb/s, with occasional spikes to 160 kb/s. So it needs to delay just a bit longer... I'm unsure why. However, at the beginning a lot of data flows before it determines the right bandwidth limit. A granularity of less than 1s would probably improve that. And, I don't know yet if it makes sense to have it be 100ks/1s rather than 100kb/s. Is there a situation where the user would want a larger granularity? Does granulatity need to be configurable at all? I only used that format for the config really in order to reuse an existing parser. This can't support for external special remotes, or for ones that themselves shell out to an external command. (Well, it could, but it would involve pausing and resuming the child process tree, which seems very hard to implement and very strange besides.) There could also be some built-in special remotes that it still doesn't work for, due to them not having a progress meter whose displays blocks the bandwidth using thread. But I don't think there are actually any that run a separate thread for downloads than the thread that displays the progress meter. Sponsored-by: Graham Spencer on Patreon
83 lines
2.6 KiB
Haskell
83 lines
2.6 KiB
Haskell
{- Stall detection for transfers.
|
|
-
|
|
- Copyright 2020-2021 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.StallDetection (detectStalls, StallDetection) where
|
|
|
|
import Annex.Common
|
|
import Types.StallDetection
|
|
import Utility.Metered
|
|
import Utility.HumanTime
|
|
import Utility.DataUnits
|
|
import Utility.ThreadScheduler
|
|
|
|
import Control.Concurrent.STM
|
|
import Control.Monad.IO.Class (MonadIO)
|
|
|
|
{- This may be safely canceled (with eg uninterruptibleCancel),
|
|
- as long as the passed action can be safely canceled. -}
|
|
detectStalls :: (Monad m, MonadIO m) => Maybe StallDetection -> TVar (Maybe BytesProcessed) -> m () -> m ()
|
|
detectStalls Nothing _ _ = noop
|
|
detectStalls (Just StallDetectionDisabled) _ _ = noop
|
|
detectStalls (Just (StallDetection (BwRate minsz duration))) metervar onstall =
|
|
detectStalls' minsz duration metervar onstall Nothing
|
|
detectStalls (Just ProbeStallDetection) metervar onstall = do
|
|
-- Only do stall detection once the progress is confirmed to be
|
|
-- consistently updating. After the first update, it needs to
|
|
-- advance twice within 30 seconds. With that established,
|
|
-- if no data at all is sent for a 60 second period, it's
|
|
-- assumed to be a stall.
|
|
v <- getval >>= waitforfirstupdate
|
|
ontimelyadvance v $ \v' -> ontimelyadvance v' $
|
|
detectStalls' 1 duration metervar onstall
|
|
where
|
|
getval = liftIO $ atomically $ fmap fromBytesProcessed
|
|
<$> readTVar metervar
|
|
|
|
duration = Duration 60
|
|
|
|
delay = Seconds (fromIntegral (durationSeconds duration) `div` 2)
|
|
|
|
waitforfirstupdate startval = do
|
|
liftIO $ threadDelaySeconds delay
|
|
v <- getval
|
|
if v > startval
|
|
then return v
|
|
else waitforfirstupdate startval
|
|
|
|
ontimelyadvance v cont = do
|
|
liftIO $ threadDelaySeconds delay
|
|
v' <- getval
|
|
when (v' > v) $
|
|
cont v'
|
|
|
|
detectStalls'
|
|
:: (Monad m, MonadIO m)
|
|
=> ByteSize
|
|
-> Duration
|
|
-> TVar (Maybe BytesProcessed)
|
|
-> m ()
|
|
-> Maybe ByteSize
|
|
-> m ()
|
|
detectStalls' minsz duration metervar onstall st = do
|
|
liftIO $ threadDelaySeconds delay
|
|
-- Get whatever progress value was reported most recently, if any.
|
|
v <- liftIO $ atomically $ fmap fromBytesProcessed
|
|
<$> readTVar metervar
|
|
let cont = detectStalls' minsz duration metervar onstall v
|
|
case (st, v) of
|
|
(Nothing, _) -> cont
|
|
(_, Nothing) -> cont
|
|
(Just prev, Just sofar)
|
|
-- Just in case a progress meter somehow runs
|
|
-- backwards, or a second progress meter was
|
|
-- started and is at a smaller value than
|
|
-- the previous one.
|
|
| prev > sofar -> cont
|
|
| sofar - prev < minsz -> onstall
|
|
| otherwise -> cont
|
|
where
|
|
delay = Seconds (fromIntegral (durationSeconds duration))
|