summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-08-24 13:04:28 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-08-24 13:08:38 -0400
commit72e110ce5d361b5b2621c972d6fe317c38e8cfca (patch)
tree03e09076a53a1569e19591ed3ac9d0733cc4c6c5
parent1f83dafc7e9be3e06362dcb3009b42c940d6057c (diff)
avoid requeueing a download from a remote that no longer has a key
-rw-r--r--Assistant/DaemonStatus.hs1
-rw-r--r--Assistant/Threads/TransferScanner.hs42
2 files changed, 30 insertions, 13 deletions
diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs
index 44789290c..4a9dfb4e2 100644
--- a/Assistant/DaemonStatus.hs
+++ b/Assistant/DaemonStatus.hs
@@ -22,7 +22,6 @@ import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import qualified Data.Map as M
-import Control.Exception
data DaemonStatus = DaemonStatus
-- False when the daemon is performing its startup scan
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 8dc3a6a98..d1d27e480 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -49,12 +49,30 @@ failedTransferScan st dstatus transferqueue r = do
go ts
where
go [] = noop
- go ((t, info):ts) = do
+ go ((t, info):ts)
+ | transferDirection t == Download = do
+ {- Check if the remote still has the key.
+ - If not, relies on the expensiveScan to
+ - get it queued from some other remote. -}
+ ifM (runThreadState st $ remoteHas r $ transferKey t)
+ ( requeue t info
+ , dequeue t
+ )
+ go ts
+ | otherwise = do
+ {- The Transferrer checks when uploading
+ - that the remote doesn't already have the
+ - key, so it's not redundantly checked
+ - here. -}
+ requeue t info
+ go ts
+
+ requeue t info = do
queueTransferWhenSmall
transferqueue dstatus (associatedFile info) t r
- void $ runThreadState st $ inRepo $
- liftIO . tryIO . removeFile . failedTransferFile t
- go ts
+ dequeue t
+ dequeue t = void $ runThreadState st $ inRepo $
+ liftIO . tryIO . removeFile . failedTransferFile t
{- This is a expensive scan through the full git work tree.
-
@@ -79,17 +97,17 @@ expensiveScan st dstatus transferqueue r = do
go fs
where
check _ (key, _) = ifM (inAnnex key)
- ( helper key Upload False =<< remotehas key
- , helper key Download True =<< remotehas key
+ ( helper key Upload False =<< remoteHas r key
+ , helper key Download True =<< remoteHas r key
)
helper key direction x y
- | x == y = return $
- Just $ Transfer direction u key
+ | x == y = return $ Just $
+ Transfer direction (Remote.uuid r) key
| otherwise = return Nothing
- u = Remote.uuid r
enqueue f t = queueTransferWhenSmall transferqueue dstatus (Just f) t r
- remotehas key = elem
- <$> pure u
- <*> loggedLocations key
+remoteHas :: Remote -> Key -> Annex Bool
+remoteHas r key = elem
+ <$> pure (Remote.uuid r)
+ <*> loggedLocations key