avoid watchFileSize running backward

This is groundwork for using watchFileSize for downloads from external
special remotes.

In Annex.Content.downloadUrl, this potentially avoids jitter in the
progress meter. When downloading with conduit, the meter gets updated based
on both the size of the file, and on the data flowing through conduit.
If that has not yet been flushed to the file, it seems possible for the
meter to run backwards when meter is updated with the file size.
It's probably only a few kb of jitter, so may not be visible.

Sponsored-by: Dartmouth College's DANDI project
This commit is contained in:
Joey Hess 2024-01-19 14:11:27 -04:00
parent 856c28508d
commit 703a70cafa
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 41 additions and 15 deletions

View file

@ -753,7 +753,7 @@ downloadUrl listfailedurls k p iv urls file uo =
-- download command is used.
meteredFile file (Just p) k (go urls [])
where
go (u:us) errs = Url.download' p iv u file uo >>= \case
go (u:us) errs p' = Url.download' p' iv u file uo >>= \case
Right () -> return True
Left err -> do
-- If the incremental verifier was fed anything
@ -765,9 +765,9 @@ downloadUrl listfailedurls k p iv urls file uo =
Just n | n > 0 -> unableIncrementalVerifier iv'
_ -> noop
Nothing -> noop
go us ((u, err) : errs)
go [] [] = return False
go [] errs@((_, err):_) = do
go us ((u, err) : errs) p'
go [] [] _ = return False
go [] errs@((_, err):_) _ = do
if listfailedurls
then warning $ UnquotedString $
unlines $ flip map errs $ \(u, err') ->

View file

@ -57,7 +57,7 @@ tryCopyCoW (CopyCoWTried copycowtried) src dest meterupdate =
)
)
where
docopycow = watchFileSize dest meterupdate $
docopycow = watchFileSize dest meterupdate $ const $
copyCoW CopyTimeStamps src dest
dest' = toRawFilePath dest

View file

@ -171,7 +171,7 @@ metered' st setclear othermeterupdate msize bwlimit showoutput a = go st
minratelimit = min consoleratelimit jsonratelimit
{- Poll file size to display meter. -}
meteredFile :: FilePath -> Maybe MeterUpdate -> Key -> Annex a -> Annex a
meteredFile :: FilePath -> Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
meteredFile file combinemeterupdate key a =
metered combinemeterupdate key Nothing $ \_ p ->
watchFileSize file p a

View file

@ -1,6 +1,6 @@
{- Metered IO and actions
-
- Copyright 2012-2021 Joey Hess <id@joeyh.name>
- Copyright 2012-2024 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
@ -218,23 +218,49 @@ defaultChunkSize = 32 * k - chunkOverhead
- away and start over. To avoid reporting the original file size followed
- by a smaller size in that case, wait until the file starts growing
- before updating the meter for the first time.
-
- An updated version of the MeterUpdate is passed to the action, and the
- action should use that for any updates that it makes. This allows for
- eg, the action updating the meter before a write is flushed to the file.
- In that situation, this avoids the meter being set back to the size of
- the file when it's gotten ahead of that point.
-}
watchFileSize :: (MonadIO m, MonadMask m) => FilePath -> MeterUpdate -> m a -> m a
watchFileSize f p a = bracket
(liftIO $ forkIO $ watcher =<< getsz)
(liftIO . void . tryIO . killThread)
(const a)
watchFileSize
:: (MonadIO m, MonadMask m)
=> FilePath
-> MeterUpdate
-> (MeterUpdate -> m a)
-> m a
watchFileSize f p a = do
sizevar <- liftIO $ newMVar zeroBytesProcessed
bracket
(liftIO $ forkIO $ watcher (meterupdate sizevar True) =<< getsz)
(liftIO . void . tryIO . killThread)
(const (a (meterupdate sizevar False)))
where
watcher oldsz = do
watcher p' oldsz = do
threadDelay 500000 -- 0.5 seconds
sz <- getsz
when (sz > oldsz) $
p sz
watcher sz
p' sz
watcher p' sz
getsz = catchDefaultIO zeroBytesProcessed $
toBytesProcessed <$> getFileSize f'
f' = toRawFilePath f
meterupdate sizevar preventbacktracking n
| preventbacktracking = do
old <- takeMVar sizevar
if old > n
then putMVar sizevar old
else do
putMVar sizevar n
p n
| otherwise = do
void $ takeMVar sizevar
putMVar sizevar n
p n
data OutputHandler = OutputHandler
{ quietMode :: Bool
, stderrHandler :: String -> IO ()