diff options
author | 2012-10-18 15:37:57 -0400 | |
---|---|---|
committer | 2012-10-18 15:37:57 -0400 | |
commit | 2422fc199fb859b502ab61cbc0d64604b93508a9 (patch) | |
tree | c702ef20c0ffd0b14327b704a6a8267424fe72c3 /Assistant/Threads | |
parent | 3e369ace228e984224c417c6f3524f0b4f5900ac (diff) |
check and drop unwanted content from remotes after receiving a transfer
Diffstat (limited to 'Assistant/Threads')
-rw-r--r-- | Assistant/Threads/TransferScanner.hs | 2 | ||||
-rw-r--r-- | Assistant/Threads/TransferWatcher.hs | 30 |
2 files changed, 19 insertions, 13 deletions
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs index 5eb3784bd..4cd6915f5 100644 --- a/Assistant/Threads/TransferScanner.hs +++ b/Assistant/Threads/TransferScanner.hs @@ -125,7 +125,7 @@ expensiveScan st dstatus transferqueue rs = unless onlyweb $ do syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus present <- inAnnex key - handleDrops' locs syncrs present f key + handleDrops locs syncrs present f key let slocs = S.fromList locs let use a = return $ catMaybes $ map (a key slocs) syncrs diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs index a54128cb6..19009756b 100644 --- a/Assistant/Threads/TransferWatcher.hs +++ b/Assistant/Threads/TransferWatcher.hs @@ -11,6 +11,7 @@ import Assistant.Common import Assistant.ThreadedMonad import Assistant.DaemonStatus import Assistant.TransferQueue +import Assistant.Drop import Annex.Content import Logs.Transfer import Utility.DirWatcher @@ -102,16 +103,21 @@ onDel st dstatus transferqueue file _ = case parseTransferFile file of , show t ] minfo <- removeTransfer dstatus t + finishedTransfer st dstatus transferqueue t minfo - {- Queue uploads of files we successfully downloaded, - - spreading them out to other reachable remotes. -} - case (minfo, transferDirection t) of - (Just info, Download) -> runThreadState st $ - whenM (inAnnex $ transferKey t) $ - queueTransfersMatching - (/= transferUUID t) - Later transferqueue dstatus - (transferKey t) - (associatedFile info) - Upload - _ -> noop +{- Queue uploads of files we successfully downloaded, spreading them + - out to other reachable remotes. + - + - Also, downloading a file may have caused a remote to not want it, + - so drop it from the remote. -} +finishedTransfer :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Transfer -> Maybe TransferInfo -> IO () +finishedTransfer st dstatus transferqueue t (Just info) + | transferDirection t == Download = runThreadState st $ + whenM (inAnnex $ transferKey t) $ do + handleRemoteDrops dstatus + (transferKey t) (associatedFile info) + queueTransfersMatching (/= transferUUID t) + Later transferqueue dstatus + (transferKey t) (associatedFile info) Upload + | otherwise = noop +finishedTransfer _ _ _ _ _ = noop |