diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-10-18 15:37:57 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-10-18 15:37:57 -0400 |
| commit | 2422fc199fb859b502ab61cbc0d64604b93508a9 (patch) | |
| tree | c702ef20c0ffd0b14327b704a6a8267424fe72c3 /Assistant/Threads/TransferWatcher.hs | |
| parent | 3e369ace228e984224c417c6f3524f0b4f5900ac (diff) | |
check and drop unwanted content from remotes after receiving a transfer
Diffstat (limited to 'Assistant/Threads/TransferWatcher.hs')
| -rw-r--r-- | Assistant/Threads/TransferWatcher.hs | 30 |
1 files changed, 18 insertions, 12 deletions
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 |