check and drop unwanted content from remotes after receiving a transfer
This commit is contained in:
parent
dea125e1b7
commit
ee9e0702a2
4 changed files with 33 additions and 28 deletions
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue