diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-12-06 13:22:16 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-12-06 13:22:16 -0400 |
| commit | 2a04e215e10469ee3bab5d1a5d6d76b0c35cc46c (patch) | |
| tree | 41328caa30ae494316d20e1a5e5909b29aa94516 /Assistant | |
| parent | 53304252ca5483ce80f5a66bb74cc9f0732f65d7 (diff) | |
--auto fixes
* get/copy --auto: Transfer data even if it would exceed numcopies,
when preferred content settings want it.
* drop --auto: Fix dropping content when there are no preferred content
settings.
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Drop.hs | 2 | ||||
| -rw-r--r-- | Assistant/Threads/TransferScanner.hs | 4 | ||||
| -rw-r--r-- | Assistant/TransferQueue.hs | 4 |
3 files changed, 5 insertions, 5 deletions
diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs index 8098300ae..4dd13f2fa 100644 --- a/Assistant/Drop.hs +++ b/Assistant/Drop.hs @@ -58,7 +58,7 @@ handleDropsFrom locs rs fromhere key (Just f) knownpresentremote | checkcopies n = dropr r n >>= go rest | otherwise = noop - checkdrop n@(_, numcopies) u a = ifM (wantDrop u (Just f)) + checkdrop n@(_, numcopies) u a = ifM (wantDrop True u (Just f)) ( ifM (safely $ doCommand $ a (Just numcopies)) ( return $ decrcopies n , return n diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index da3f0608f..9b863d306 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -124,9 +124,9 @@ expensiveScan rs = unless onlyweb $ do let slocs = S.fromList locs let use a = return $ catMaybes $ map (a key slocs) syncrs if present - then filterM (wantSend (Just f) . Remote.uuid . fst) + then filterM (wantSend True (Just f) . Remote.uuid . fst) =<< use (genTransfer Upload False) - else ifM (wantGet $ Just f) + else ifM (wantGet True $ Just f) ( use (genTransfer Download True) , return [] ) genTransfer :: Direction -> Bool -> Key -> S.Set UUID -> Remote -> Maybe (Remote, Transfer) diff --git a/Assistant/TransferQueue.hs b/Assistant/TransferQueue.hs index 4d46b0920..66d761f6e 100644 --- a/Assistant/TransferQueue.hs +++ b/Assistant/TransferQueue.hs @@ -52,7 +52,7 @@ queueTransfers = queueTransfersMatching (const True) - condition. Honors preferred content settings. -} queueTransfersMatching :: (UUID -> Bool) -> Schedule -> Key -> AssociatedFile -> Direction -> Assistant () queueTransfersMatching matching schedule k f direction - | direction == Download = whenM (liftAnnex $ wantGet f) go + | direction == Download = whenM (liftAnnex $ wantGet True f) go | otherwise = go where go = do @@ -72,7 +72,7 @@ queueTransfersMatching matching schedule k f direction uuids <- Remote.keyLocations k return $ filter (\r -> uuid r `elem` uuids) rs {- Upload to all remotes that want the content. -} - | otherwise = filterM (wantSend f . Remote.uuid) $ + | otherwise = filterM (wantSend True f . Remote.uuid) $ filter (not . Remote.readonly) rs gentransfer r = Transfer { transferDirection = direction |