f04d9574d6
While redundant concurrent transfers were already prevented in most cases, it failed to prevent the case where two different repositories were sending the same content to the same repository. By removing the uuid from the transfer lock file for Download transfers, one repository sending content will block the other one from also sending the same content. In order to interoperate with old git-annex, the old lock file is still locked, as well as locking the new one. That added a lot of extra code and work, and the plan is to eventually stop locking the old lock file, at some point in time when an old git-annex process is unlikely to be running at the same time. Note that in the case of 2 repositories both doing eg `git-annex copy foo --to origin` the output is not that great: copy b (to origin...) transfer already in progress, or unable to take transfer lock git-annex: transfer already in progress, or unable to take transfer lock 97% 966.81 MiB 534 GiB/s 0sp2pstdio: 1 failed Lost connection (fd:14: hPutBuf: resource vanished (Broken pipe)) Transfer failed Perhaps that output could be cleaned up? Anyway, it's a lot better than letting the redundant transfer happen and then failing with an obscure error about a temp file, which is what it did before. And it seems users don't often try to do this, since nobody ever reported this bug to me before. (The "97%" there is actually how far along the *other* transfer is.) Sponsored-by: Joshua Antonishen on Patreon
56 lines
1.9 KiB
Haskell
56 lines
1.9 KiB
Haskell
{- git-annex assistant transfer polling thread
|
|
-
|
|
- Copyright 2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Assistant.Threads.TransferPoller where
|
|
|
|
import Assistant.Common
|
|
import Assistant.DaemonStatus
|
|
import Types.Transfer
|
|
import Logs.Transfer
|
|
import Utility.NotificationBroadcaster
|
|
import qualified Assistant.Threads.TransferWatcher as TransferWatcher
|
|
|
|
import Control.Concurrent
|
|
import qualified Data.Map as M
|
|
|
|
{- This thread polls the status of ongoing transfers, determining how much
|
|
- of each transfer is complete. -}
|
|
transferPollerThread :: NamedThread
|
|
transferPollerThread = namedThread "TransferPoller" $ do
|
|
g <- liftAnnex gitRepo
|
|
tn <- liftIO . newNotificationHandle True =<<
|
|
transferNotifier <$> getDaemonStatus
|
|
forever $ do
|
|
liftIO $ threadDelay 500000 -- 0.5 seconds
|
|
ts <- currentTransfers <$> getDaemonStatus
|
|
if M.null ts
|
|
-- block until transfers running
|
|
then liftIO $ waitNotification tn
|
|
else mapM_ (poll g) $ M.toList ts
|
|
where
|
|
poll g (t, info)
|
|
{- Downloads are polled by checking the size of the
|
|
- temp file being used for the transfer. -}
|
|
| transferDirection t == Download = do
|
|
let f = gitAnnexTmpObjectLocation (transferKey t) g
|
|
sz <- liftIO $ catchMaybeIO $ getFileSize f
|
|
newsize t info sz
|
|
{- Uploads don't need to be polled for when the TransferWatcher
|
|
- thread can track file modifications. -}
|
|
| TransferWatcher.watchesTransferSize = noop
|
|
{- Otherwise, this code polls the upload progress
|
|
- by reading the transfer info file. -}
|
|
| otherwise = do
|
|
let (f, _, _) = transferFileAndLockFile t g
|
|
mi <- liftIO $ catchDefaultIO Nothing $
|
|
readTransferInfoFile Nothing (fromRawFilePath f)
|
|
maybe noop (newsize t info . bytesComplete) mi
|
|
|
|
newsize t info sz
|
|
| bytesComplete info /= sz && isJust sz =
|
|
alterTransferInfo t $ \i -> i { bytesComplete = sz }
|
|
| otherwise = noop
|