b6ba0bd556
Similar to the assistant, this honors any configured preferred content expressions. I am not entirely happpy with the implementation. It would be nicer if the seek function returned a list of actions which included the individual file gets and copies and drops, rather than the current list of calls to syncContent. This would allow getting rid of the somewhat reundant display of "sync file [ok|failed]" after the get/put display. But, do that, withFilesInGit would need to somehow be able to construct such a mixed action list. And it would be less efficient than the current implementation, which is able to reuse several values between eg get and drop. Note that currently this does not try to satisfy numcopies when getting/putting files (numcopies are of course checked when dropping files!) This makes it like the assistant, and unlike get --auto and copy --auto, which do duplicate files when numcopies is not yet satisfied. I don't know if this is the right decision; it only seemed to make sense to have this parallel the assistant as far as possible to start with, since I know the assistant works. This commit was sponsored by Øyvind Andersen Holm.
118 lines
3.7 KiB
Haskell
118 lines
3.7 KiB
Haskell
{- dropping of unwanted content
|
|
-
|
|
- Copyright 2012-2014 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.Drop where
|
|
|
|
import Common.Annex
|
|
import Logs.Location
|
|
import Logs.Trust
|
|
import Types.Remote (uuid)
|
|
import qualified Remote
|
|
import qualified Command.Drop
|
|
import Command
|
|
import Annex.Wanted
|
|
import Annex.Exception
|
|
import Config
|
|
import Annex.Content.Direct
|
|
|
|
import qualified Data.Set as S
|
|
import System.Log.Logger (debugM)
|
|
|
|
type Reason = String
|
|
|
|
{- Drop a key from local and/or remote when allowed by the preferred content
|
|
- and numcopies settings.
|
|
-
|
|
- The Remote list can include other remotes that do not have the content.
|
|
-
|
|
- A remote can be specified that is known to have the key. This can be
|
|
- used an an optimisation when eg, a key has just been uploaded to a
|
|
- remote.
|
|
-}
|
|
handleDrops :: Reason -> [Remote] -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Annex ()
|
|
handleDrops _ _ _ _ Nothing _ = noop
|
|
handleDrops reason rs fromhere key f knownpresentremote = do
|
|
locs <- loggedLocations key
|
|
handleDropsFrom locs rs reason fromhere key f knownpresentremote
|
|
|
|
{- The UUIDs are ones where the content is believed to be present.
|
|
- The Remote list can include other remotes that do not have the content;
|
|
- only ones that match the UUIDs will be dropped from.
|
|
- If allowed to drop fromhere, that drop will be tried first.
|
|
-
|
|
- In direct mode, all associated files are checked, and only if all
|
|
- of them are unwanted are they dropped.
|
|
-}
|
|
handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Annex ()
|
|
handleDropsFrom _ _ _ _ _ Nothing _ = noop
|
|
handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
|
|
fs <- ifM isDirect
|
|
( do
|
|
l <- associatedFilesRelative key
|
|
if null l
|
|
then return [afile]
|
|
else return l
|
|
, return [afile]
|
|
)
|
|
n <- getcopies fs
|
|
if fromhere && checkcopies n Nothing
|
|
then go fs rs =<< dropl fs n
|
|
else go fs rs n
|
|
where
|
|
getcopies fs = do
|
|
(untrusted, have) <- trustPartition UnTrusted locs
|
|
numcopies <- maximum <$> mapM (getNumCopies <=< numCopies) fs
|
|
return (length have, numcopies, S.fromList untrusted)
|
|
|
|
{- Check that we have enough copies still to drop the content.
|
|
- When the remote being dropped from is untrusted, it was not
|
|
- counted as a copy, so having only numcopies suffices. Otherwise,
|
|
- we need more than numcopies to safely drop. -}
|
|
checkcopies (have, numcopies, _untrusted) Nothing = have > numcopies
|
|
checkcopies (have, numcopies, untrusted) (Just u)
|
|
| S.member u untrusted = have >= numcopies
|
|
| otherwise = have > numcopies
|
|
|
|
decrcopies (have, numcopies, untrusted) Nothing =
|
|
(have - 1, numcopies, untrusted)
|
|
decrcopies v@(_have, _numcopies, untrusted) (Just u)
|
|
| S.member u untrusted = v
|
|
| otherwise = decrcopies v Nothing
|
|
|
|
go _ [] _ = noop
|
|
go fs (r:rest) n
|
|
| uuid r `S.notMember` slocs = go fs rest n
|
|
| checkcopies n (Just $ Remote.uuid r) =
|
|
dropr fs r n >>= go fs rest
|
|
| otherwise = noop
|
|
|
|
checkdrop fs n@(have, numcopies, _untrusted) u a =
|
|
ifM (allM (wantDrop True u . Just) fs)
|
|
( ifM (safely $ doCommand $ a (Just numcopies))
|
|
( do
|
|
liftIO $ debugM "drop" $ unwords
|
|
[ "dropped"
|
|
, afile
|
|
, "(from " ++ maybe "here" show u ++ ")"
|
|
, "(copies now " ++ show (have - 1) ++ ")"
|
|
, ": " ++ reason
|
|
]
|
|
return $ decrcopies n u
|
|
, return n
|
|
)
|
|
, return n
|
|
)
|
|
|
|
dropl fs n = checkdrop fs n Nothing $ \numcopies ->
|
|
Command.Drop.startLocal (Just afile) numcopies key knownpresentremote
|
|
|
|
dropr fs r n = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
|
|
Command.Drop.startRemote (Just afile) numcopies key r
|
|
|
|
safely a = either (const False) id <$> tryAnnex a
|
|
|
|
slocs = S.fromList locs
|