check and drop unwanted content from remotes after receiving a transfer

This commit is contained in:
Joey Hess 2012-10-18 15:37:57 -04:00
parent dea125e1b7
commit ee9e0702a2
4 changed files with 33 additions and 28 deletions

View file

@ -8,24 +8,30 @@
module Assistant.Drop where module Assistant.Drop where
import Assistant.Common import Assistant.Common
import Assistant.DaemonStatus
import Logs.Location import Logs.Location
import Logs.Trust import Logs.Trust
import Types.Remote (AssociatedFile)
import qualified Remote import qualified Remote
import qualified Command.Drop import qualified Command.Drop
import Command import Command
import Annex.Wanted import Annex.Wanted
import Config import Config
{- Drop from local or remote when allowed by the preferred content and {- Drop from syncable remotes when allowed by the preferred content and
- numcopies settings. -} - numcopies settings. -}
handleDrops :: [Remote] -> Bool -> FilePath -> Key -> Annex () handleRemoteDrops :: DaemonStatusHandle -> Key -> AssociatedFile -> Annex ()
handleDrops rs present f key = do handleRemoteDrops dstatus key (Just f) = do
syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
locs <- loggedLocations key locs <- loggedLocations key
handleDrops' locs rs present f key handleDrops locs syncrs False f key
handleRemoteDrops _ _ _ = noop
handleDrops' :: [UUID] -> [Remote] -> Bool -> FilePath -> Key -> Annex () {- Drop from local and/or remote when allowed by the preferred content and
handleDrops' locs rs present f key - numcopies settings. -}
| present = do handleDrops :: [UUID] -> [Remote] -> Bool -> FilePath -> Key -> Annex ()
handleDrops locs rs fromhere f key
| fromhere = do
n <- getcopies n <- getcopies
if checkcopies n if checkcopies n
then go rs =<< dropl n then go rs =<< dropl n

View file

@ -125,7 +125,7 @@ expensiveScan st dstatus transferqueue rs = unless onlyweb $ do
syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
present <- inAnnex key present <- inAnnex key
handleDrops' locs syncrs present f key handleDrops locs syncrs present f key
let slocs = S.fromList locs let slocs = S.fromList locs
let use a = return $ catMaybes $ map (a key slocs) syncrs let use a = return $ catMaybes $ map (a key slocs) syncrs

View file

@ -11,6 +11,7 @@ import Assistant.Common
import Assistant.ThreadedMonad import Assistant.ThreadedMonad
import Assistant.DaemonStatus import Assistant.DaemonStatus
import Assistant.TransferQueue import Assistant.TransferQueue
import Assistant.Drop
import Annex.Content import Annex.Content
import Logs.Transfer import Logs.Transfer
import Utility.DirWatcher import Utility.DirWatcher
@ -102,16 +103,21 @@ onDel st dstatus transferqueue file _ = case parseTransferFile file of
, show t , show t
] ]
minfo <- removeTransfer dstatus t minfo <- removeTransfer dstatus t
finishedTransfer st dstatus transferqueue t minfo
{- Queue uploads of files we successfully downloaded, {- Queue uploads of files we successfully downloaded, spreading them
- spreading them out to other reachable remotes. -} - out to other reachable remotes.
case (minfo, transferDirection t) of -
(Just info, Download) -> runThreadState st $ - Also, downloading a file may have caused a remote to not want it,
whenM (inAnnex $ transferKey t) $ - so drop it from the remote. -}
queueTransfersMatching finishedTransfer :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Transfer -> Maybe TransferInfo -> IO ()
(/= transferUUID t) finishedTransfer st dstatus transferqueue t (Just info)
Later transferqueue dstatus | transferDirection t == Download = runThreadState st $
(transferKey t) whenM (inAnnex $ transferKey t) $ do
(associatedFile info) handleRemoteDrops dstatus
Upload (transferKey t) (associatedFile info)
_ -> noop queueTransfersMatching (/= transferUUID t)
Later transferqueue dstatus
(transferKey t) (associatedFile info) Upload
| otherwise = noop
finishedTransfer _ _ _ _ _ = noop

View file

@ -32,7 +32,7 @@ the same content, this gets tricky. Let's assume there are not.)
with this is an expensive scan. (The rest of the items below come from with this is an expensive scan. (The rest of the items below come from
analizing the terminals used in preferred content expressions.) **done** analizing the terminals used in preferred content expressions.) **done**
2. renaming of a file (ie, moved to `archive/`) 2. renaming of a file (ie, moved to `archive/`)
3. we get a file (`in`, `copies`) 3. we get a file (`in`, `copies`) **done**
4. some other repository drops the file (`in`, `copies` .. However, it's 4. some other repository drops the file (`in`, `copies` .. However, it's
unlikely that an expression would prefer content when *more* copies unlikely that an expression would prefer content when *more* copies
exisited, and want to drop it when less do. That's nearly a pathological exisited, and want to drop it when less do. That's nearly a pathological
@ -41,13 +41,6 @@ the same content, this gets tricky. Let's assume there are not.)
That's all! Of these, 1, 2 and 3 are by far the most important. That's all! Of these, 1, 2 and 3 are by far the most important.
Rename handling should certianly check 2.
One place to check for 3 is after transferring a file; but that does not
cover all its cases, as some other repo could transfer the file. To fully
handle 3, need to either use a full scan, or examine location log history
when receiving a git-annex branch push.
## specifying what data a remote prefers to contain **done** ## specifying what data a remote prefers to contain **done**
Imagine a per-remote preferred content setting, that matches things that Imagine a per-remote preferred content setting, that matches things that