diff options
| -rw-r--r-- | Assistant/TransferQueue.hs | 24 | ||||
| -rw-r--r-- | debian/changelog | 1 |
2 files changed, 17 insertions, 8 deletions
diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 5974c70d1..5f68ba628 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -32,6 +32,7 @@ import Annex.Wanted import Control.Concurrent.STM import qualified Data.Map as M +import qualified Data.Set as S type Reason = String @@ -58,6 +59,7 @@ queueTransfersMatching matching reason schedule k f direction | otherwise = go where go = do + rs <- liftAnnex . selectremotes =<< syncDataRemotes <$> getDaemonStatus let matchingrs = filter (matching . Remote.uuid) rs @@ -67,15 +69,21 @@ queueTransfersMatching matching reason schedule k f direction enqueue reason schedule (gentransfer r) (stubInfo f r) selectremotes rs {- Queue downloads from all remotes that - - have the key, with the cheapest ones first. - - More expensive ones will only be tried if - - downloading from a cheap one fails. -} + - have the key. The list of remotes is ordered with + - cheapest first. More expensive ones will only be tried + - if downloading from a cheap one fails. -} | direction == Download = do - uuids <- Remote.keyLocations k - return $ filter (\r -> uuid r `elem` uuids) rs - {- Upload to all remotes that want the content. -} - | otherwise = filterM (wantSend True f . Remote.uuid) $ - filter (not . Remote.readonly) rs + s <- locs + return $ filter (inset s) rs + {- Upload to all remotes that want the content and don't + - already have it. -} + | otherwise = do + s <- locs + filterM (wantSend True f . Remote.uuid) $ + filter (\r -> not (inset s r || Remote.readonly r)) rs + where + locs = S.fromList <$> Remote.keyLocations k + inset s r = S.member (Remote.uuid r) s gentransfer r = Transfer { transferDirection = direction , transferKey = k diff --git a/debian/changelog b/debian/changelog index 2e29c2cee..62c5ac62b 100644 --- a/debian/changelog +++ b/debian/changelog @@ -27,6 +27,7 @@ git-annex (4.20130324) UNRELEASED; urgency=low * assistant: Fix bug that could cause direct mode files to be unstaged from git. * Update working tree files fully atomically. + * webapp: Improved transfer queue management. -- Joey Hess <joeyh@debian.org> Mon, 25 Mar 2013 10:21:46 -0400 |