type Reason = String
-{- Drop a key from local and/or remote when allowed by the preferred content
- - and numcopies settings.
+{- Drop a key from local and/or remote when allowed by the preferred content,
+ - required content, and numcopies settings.
-
- Skips trying to drop from remotes that are appendonly, since those drops
- would presumably fail. Also skips dropping from exporttree/importtree remotes,
checkdrop fs n u a =
let afs = map (AssociatedFile . Just) fs
+ pcc = Command.Drop.PreferredContentChecked True
in ifM (wantDrop True u (Just key) afile (Just afs))
- ( dodrop n u a
+ ( dodrop n u (a pcc)
, return n
)
, return n
)
- dropl fs n = checkdrop fs n Nothing $ \numcopies mincopies ->
+ dropl fs n = checkdrop fs n Nothing $ \pcc numcopies mincopies ->
stopUnless (inAnnex key) $
- Command.Drop.startLocal afile ai si numcopies mincopies key preverified
+ Command.Drop.startLocal pcc afile ai si numcopies mincopies key preverified
- dropr fs r n = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies mincopies ->
- Command.Drop.startRemote afile ai si numcopies mincopies key r
+ dropr fs r n = checkdrop fs n (Just $ Remote.uuid r) $ \pcc numcopies mincopies ->
+ Command.Drop.startRemote pcc afile ai si numcopies mincopies key r
ai = mkActionItem (key, afile)
import Annex.CatFile
import Git.FilePath
import qualified Database.Keys
+import Types.FileMatcher
import qualified Data.Set as S
wantGet :: Bool -> Maybe Key -> AssociatedFile -> Annex Bool
wantGet d key file = isPreferredContent Nothing S.empty key file d
-{- Check if a file is preferred content for a remote. -}
+{- Check if a file is preferred content for a repository. -}
wantSend :: Bool -> Maybe Key -> AssociatedFile -> UUID -> Annex Bool
wantSend d key file to = isPreferredContent (Just to) S.empty key file d
-{- Check if a file can be dropped, maybe from a remote.
- - Don't drop files that are preferred content.
+{- Check if a file is not preferred or required content, and can be
+ - dropped. When a UUID is provided, checks for that repository.
-
- The AssociatedFile is the one that the user requested to drop.
- There may be other files that use the same key, and preferred content
- they can be provided, otherwise this looks them up.
-}
wantDrop :: Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> (Maybe [AssociatedFile]) -> Annex Bool
-wantDrop d from key file others = do
+wantDrop d from key file others =
+ isNothing <$> checkDrop isPreferredContent d from key file others
+
+{- Generalization of wantDrop that can also be used with isRequiredContent.
+ -
+ - When the content should not be dropped, returns Just the file that
+ - the checker matches.
+ -}
+checkDrop :: (Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool) -> Bool -> Maybe UUID -> Maybe Key -> AssociatedFile -> (Maybe [AssociatedFile]) -> Annex (Maybe AssociatedFile)
+checkDrop checker d from key file others = do
u <- maybe getUUID (pure . id) from
let s = S.singleton u
- let checkwant f = isPreferredContent (Just u) s key f d
- ifM (checkwant file)
- ( return False
+ let checker' f = checker (Just u) s key f d
+ ifM (checker' file)
+ ( return (Just file)
, do
others' <- case others of
Just afs -> pure (filter (/= file) afs)
mapM (\f -> AssociatedFile . Just <$> fromRepo (fromTopFilePath f))
=<< Database.Keys.getAssociatedFiles k
Nothing -> pure []
- l <- filterM checkwant others'
+ l <- filterM checker' others'
if null l
- then return True
+ then return Nothing
else checkassociated l
)
where
-- Some associated files that are in the keys database may no
-- longer correspond to files in the repository, and should
-- not prevent dropping.
- checkassociated [] = return True
- checkassociated (AssociatedFile (Just af):fs) =
- catKeyFile af >>= \case
- Just k | Just k == key -> return False
+ checkassociated [] = return Nothing
+ checkassociated (af@(AssociatedFile (Just f)):fs) =
+ catKeyFile f >>= \case
+ Just k | Just k == key -> return (Just af)
_ -> checkassociated fs
checkassociated (AssociatedFile Nothing:fs) = checkassociated fs
git-annex (8.20210429) UNRELEASED; urgency=medium
+ * When two files have the same content, and a required content expression
+ matches one but not the other, dropping the latter file will fail as it
+ would also remove the content of the required file.
* drop --auto: When two files have the same content, and a preferred content
expression matches one but not the other, do not drop the content.
* sync --content, assistant: When two unlocked files have the same
import Annex.Wanted
import Annex.Notification
-import qualified Data.Set as S
-
cmd :: Command
cmd = withGlobalOptions [jobsOption, jsonOptions, annexedMatchingOptions] $
command "drop" SectionCommon
checkDropAuto (autoMode o) from afile key $ \numcopies mincopies ->
stopUnless wantdrop $
case from of
- Nothing -> startLocal afile ai si numcopies mincopies key []
- Just remote -> startRemote afile ai si numcopies mincopies key remote
+ Nothing -> startLocal pcc afile ai si numcopies mincopies key []
+ Just remote -> startRemote pcc afile ai si numcopies mincopies key remote
where
wantdrop
| autoMode o = wantDrop False (Remote.uuid <$> from) (Just key) afile Nothing
| otherwise = return True
+ pcc = PreferredContentChecked (autoMode o)
startKeys :: DropOptions -> Maybe Remote -> (SeekInput, Key, ActionItem) -> CommandStart
startKeys o from (si, key, ai) = start' o from key (AssociatedFile Nothing) ai si
-startLocal :: AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> [VerifiedCopy] -> CommandStart
-startLocal afile ai si numcopies mincopies key preverified =
+startLocal :: PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> [VerifiedCopy] -> CommandStart
+startLocal pcc afile ai si numcopies mincopies key preverified =
starting "drop" (OnlyActionOn key ai) si $
- performLocal key afile numcopies mincopies preverified
+ performLocal pcc key afile numcopies mincopies preverified
-startRemote :: AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> Remote -> CommandStart
-startRemote afile ai si numcopies mincopies key remote =
+startRemote :: PreferredContentChecked -> AssociatedFile -> ActionItem -> SeekInput -> NumCopies -> MinCopies -> Key -> Remote -> CommandStart
+startRemote pcc afile ai si numcopies mincopies key remote =
starting ("drop " ++ Remote.name remote) (OnlyActionOn key ai) si $
- performRemote key afile numcopies mincopies remote
+ performRemote pcc key afile numcopies mincopies remote
-performLocal :: Key -> AssociatedFile -> NumCopies -> MinCopies -> [VerifiedCopy] -> CommandPerform
-performLocal key afile numcopies mincopies preverified = lockContentForRemoval key fallback $ \contentlock -> do
+performLocal :: PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> [VerifiedCopy] -> CommandPerform
+performLocal pcc key afile numcopies mincopies preverified = lockContentForRemoval key fallback $ \contentlock -> do
u <- getUUID
(tocheck, verified) <- verifiableCopies key [u]
- doDrop u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck
+ doDrop pcc u (Just contentlock) key afile numcopies mincopies [] (preverified ++ verified) tocheck
( \proof -> do
fastDebug "Command.Drop" $ unwords
[ "Dropping from here"
-- to be done except for cleaning up.
fallback = next $ cleanupLocal key
-performRemote :: Key -> AssociatedFile -> NumCopies -> MinCopies -> Remote -> CommandPerform
-performRemote key afile numcopies mincopies remote = do
+performRemote :: PreferredContentChecked -> Key -> AssociatedFile -> NumCopies -> MinCopies -> Remote -> CommandPerform
+performRemote pcc key afile numcopies mincopies remote = do
-- Filter the uuid it's being dropped from out of the lists of
-- places assumed to have the key, and places to check.
(tocheck, verified) <- verifiableCopies key [uuid]
- doDrop uuid Nothing key afile numcopies mincopies [uuid] verified tocheck
+ doDrop pcc uuid Nothing key afile numcopies mincopies [uuid] verified tocheck
( \proof -> do
fastDebug "Command.Drop" $ unwords
[ "Dropping from remote"
- verify that enough copies of a key exist to allow it to be
- safely removed (with no data loss).
-
- - Also checks if it's required content, and refuses to drop if so.
- -
- --force overrides and always allows dropping.
-}
doDrop
- :: UUID
+ :: PreferredContentChecked
+ -> UUID
-> Maybe ContentRemovalLock
-> Key
-> AssociatedFile
-> [UnVerifiedCopy]
-> (Maybe SafeDropProof -> CommandPerform, CommandPerform)
-> CommandPerform
-doDrop dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) =
+doDrop pcc dropfrom contentlock key afile numcopies mincopies skip preverified check (dropaction, nodropaction) =
ifM (Annex.getState Annex.force)
( dropaction Nothing
- , ifM (checkRequiredContent dropfrom key afile)
+ , ifM (checkRequiredContent pcc dropfrom key afile)
( verifyEnoughCopiesToDrop nolocmsg key
contentlock numcopies mincopies
skip preverified check
showLongNote "(Use --force to override this check, or adjust numcopies.)"
a
-checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool
-checkRequiredContent u k afile =
- ifM (isRequiredContent (Just u) S.empty (Just k) afile False)
- ( requiredContent
- , return True
- )
-
-requiredContent :: Annex Bool
-requiredContent = do
- showLongNote "That file is required content, it cannot be dropped!"
- showLongNote "(Use --force to override this check, or adjust required content configuration.)"
- return False
+{- Checking preferred content also checks required content, so when
+ - auto mode causes preferred content to be checked, it's redundant
+ - for checkRequiredContent to separately check required content, and
+ - providing this avoids that extra work. -}
+newtype PreferredContentChecked = PreferredContentChecked Bool
+
+checkRequiredContent :: PreferredContentChecked -> UUID -> Key -> AssociatedFile -> Annex Bool
+checkRequiredContent (PreferredContentChecked True) _ _ _ = return True
+checkRequiredContent (PreferredContentChecked False) u k afile =
+ checkDrop isRequiredContent False (Just u) (Just k) afile Nothing >>= \case
+ Nothing -> return True
+ Just afile' -> do
+ if afile == afile'
+ then showLongNote "That file is required content. It cannot be dropped!"
+ else showLongNote $ "That file has the same content as another file"
+ ++ case afile' of
+ AssociatedFile (Just f) -> " (" ++ fromRawFilePath f ++ "),"
+ AssociatedFile Nothing -> ""
+ ++ " which is required content. It cannot be dropped!"
+ showLongNote "(Use --force to override this check, or adjust required content configuration.)"
+ return False
{- In auto mode, only runs the action if there are enough
- copies on other semitrusted repositories. -}
perform from numcopies mincopies key = case from of
Just r -> do
showAction $ "from " ++ Remote.name r
- Command.Drop.performRemote key (AssociatedFile Nothing) numcopies mincopies r
+ Command.Drop.performRemote pcc key (AssociatedFile Nothing) numcopies mincopies r
Nothing -> ifM (inAnnex key)
( droplocal
, ifM (objectFileExists key)
)
)
where
- droplocal = Command.Drop.performLocal key (AssociatedFile Nothing) numcopies mincopies []
+ droplocal = Command.Drop.performLocal pcc key (AssociatedFile Nothing) numcopies mincopies []
+ pcc = Command.Drop.PreferredContentChecked False
performOther :: (Key -> Git.Repo -> RawFilePath) -> Key -> CommandPerform
performOther filespec key = do
( Command.Move.toStart Command.Move.RemoveNever afile key ai si =<< getParsed r
, do
(numcopies, mincopies) <- getnummincopies
- Command.Drop.startRemote afile ai si numcopies mincopies key =<< getParsed r
+ Command.Drop.startRemote pcc afile ai si numcopies mincopies key =<< getParsed r
)
FromRemote r -> checkFailedTransferDirection ai Download $ do
haskey <- flip Remote.hasKey key =<< getParsed r
Right False -> ifM (inAnnex key)
( do
(numcopies, mincopies) <- getnummincopies
- Command.Drop.startLocal afile ai si numcopies mincopies key []
+ Command.Drop.startLocal pcc afile ai si numcopies mincopies key []
, stop
)
where
getnummincopies = case afile of
AssociatedFile Nothing -> (,) <$> getNumCopies <*> getMinCopies
AssociatedFile (Just af) -> getFileNumMinCopies af
+ pcc = Command.Drop.PreferredContentChecked False
- repository reduces the number of copies, and should fail if
- that would violate numcopies settings.
-
- - On the other hand, when the destiation repository does not already
+ - On the other hand, when the destination repository does not already
- have a copy of a file, it can be dropped without making numcopies
- worse, so the move is allowed even if numcopies is not met.
-
-}
willDropMakeItWorse :: UUID -> UUID -> DestStartedWithCopy -> Key -> AssociatedFile -> Annex DropCheck
willDropMakeItWorse srcuuid destuuid (DestStartedWithCopy deststartedwithcopy) key afile =
- ifM (Command.Drop.checkRequiredContent srcuuid key afile)
+ ifM (Command.Drop.checkRequiredContent (Command.Drop.PreferredContentChecked False) srcuuid key afile)
( if deststartedwithcopy
then unlessforced DropCheckNumCopies
else ifM checktrustlevel
import Types.StandardGroups
import Limit
-{- Checks if a file is preferred content for the specified repository
- - (or the current repository if none is specified). -}
+{- Checks if a file is preferred content (or required content) for the
+ - specified repository (or the current repository if none is specified). -}
isPreferredContent :: Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool
isPreferredContent = checkMap preferredContentMap
, testCase "bup remote" test_bup_remote
, testCase "crypto" test_crypto
, testCase "preferred content" test_preferred_content
+ , testCase "required_content" test_required_content
, testCase "add subdirs" test_add_subdirs
, testCase "addurl" test_addurl
]
git_annex "get" ["--auto", annexedfile] "get --auto of file with exclude=*"
annexed_notpresent annexedfile
+test_required_content :: Assertion
+test_required_content = intmpclonerepo $ do
+ git_annex "get" [annexedfile] "get"
+ annexed_present annexedfile
+ git_annex "required" [".", "include=" ++ annexedfile] "annexedfile required"
+
+ git_annex_shouldfail "drop" [annexedfile] "drop of required content should fail"
+ annexed_present annexedfile
+
+ git_annex "drop" ["--auto", annexedfile] "drop --auto of required content skips it"
+ annexed_present annexedfile
+
+ writecontent annexedfiledup $ content annexedfiledup
+ add_annex annexedfiledup "add of second file with same content failed"
+ annexed_present annexedfiledup
+ annexed_present annexedfile
+
+ git_annex_shouldfail "drop" [annexedfiledup] "drop of file sharing required content should fail"
+ annexed_present annexedfiledup
+ annexed_present annexedfile
+
test_lock :: Assertion
test_lock = intmpclonerepo $ do
annexed_notpresent annexedfile
projects / git-annex.git / commitdiff