diff options
| -rw-r--r-- | Annex/NumCopies.hs | 61 | ||||
| -rw-r--r-- | Command/Drop.hs | 41 | ||||
| -rw-r--r-- | Command/Import.hs | 10 | ||||
| -rw-r--r-- | Types/NumCopies.hs | 39 | ||||
| -rw-r--r-- | debian/changelog | 11 |
5 files changed, 97 insertions, 65 deletions
diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs index a06ef0c5e..6c069c763 100644 --- a/Annex/NumCopies.hs +++ b/Annex/NumCopies.hs @@ -15,7 +15,7 @@ module Annex.NumCopies ( defaultNumCopies, numCopiesCheck, numCopiesCheck', - verifyEnoughCopies, + verifyEnoughCopiesToDrop, knownCopies, ) where @@ -93,31 +93,35 @@ numCopiesCheck' file vs have = do return $ length have `vs` needed {- Verifies that enough copies of a key exist amoung the listed remotes, - - printing an informative message if not. + - running an action with a proof if so, and printing an informative + - message if not. -} -verifyEnoughCopies +verifyEnoughCopiesToDrop :: String -- message to print when there are no known locations -> Key -> NumCopies -> [UUID] -- repos to skip considering (generally untrusted remotes) -> [VerifiedCopy] -- copies already verified to exist - -> [Remote] -- remotes to check to see if they have it - -> Annex Bool -verifyEnoughCopies nolocmsg key need skip preverified tocheck = + -> [Remote] -- remotes to check to see if they have copies + -> (SafeDropProof -> Annex a) -- action to perform to drop + -> Annex a -- action to perform when unable to drop + -> Annex a +verifyEnoughCopiesToDrop nolocmsg key need skip preverified tocheck dropaction nodropaction = helper [] [] preverified (nub tocheck) where - helper bad missing have [] - | NumCopies (length have) >= need = return True - | otherwise = do - notEnoughCopies key need have (skip++missing) bad nolocmsg - return False + helper bad missing have [] = do + p <- liftIO $ mkSafeDropProof need have + case p of + Right proof -> dropaction proof + Left stillhave -> do + notEnoughCopies key need stillhave (skip++missing) bad nolocmsg + nodropaction helper bad missing have (r:rs) - | verifiedEnoughCopies need have = do - stillhave <- liftIO $ filterM checkVerifiedCopy have - if verifiedEnoughCopies need stillhave - then return True - else helper bad missing stillhave (r:rs) - | any safeVerification have = helper bad missing have rs + | isSafeDrop need have = do + p <- liftIO $ mkSafeDropProof need have + case p of + Right proof -> dropaction proof + Left stillhave -> helper bad missing stillhave (r:rs) | otherwise = do haskey <- Remote.hasKey r key case haskey of @@ -125,29 +129,6 @@ verifyEnoughCopies nolocmsg key need skip preverified tocheck = Left _ -> helper (r:bad) missing have rs Right False -> helper bad (Remote.uuid r:missing) have rs -{- Check whether enough verification has been done of copies to allow - - dropping content safely. - - - - Unless numcopies is 0, at least one VerifiedCopyLock or TrustedCopy - - is required. A VerifiedCopyLock prevents races between concurrent - - drops from dropping the last copy, no matter what. - - - - The other N-1 copies can be less strong verifications, like - - RecentlyVerifiedCopy. While those are subject to concurrent drop races, - - and so could be dropped all at once, causing numcopies to be violated, - - this is the best that can be done without requiring all special remotes - - to support locking. - -} -verifiedEnoughCopies :: NumCopies -> [VerifiedCopy] -> Bool -verifiedEnoughCopies (NumCopies n) l - | n == 0 = True - | otherwise = length (deDupVerifiedCopies l) >= n && any safeVerification l - -safeVerification :: VerifiedCopy -> Bool -safeVerification (VerifiedCopyLock _) = True -safeVerification (TrustedCopy _) = True -safeVerification (RecentlyVerifiedCopy _) = False - notEnoughCopies :: Key -> NumCopies -> [VerifiedCopy] -> [UUID] -> [Remote] -> String -> Annex () notEnoughCopies key need have skip bad nolocmsg = do showNote "unsafe" diff --git a/Command/Drop.hs b/Command/Drop.hs index 26872c6c0..fa8ac45ad 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -99,12 +99,12 @@ performLocal key afile numcopies preverified = lockContentExclusive key $ \conte untrusteduuids <- trustGet UnTrusted let tocheck = Remote.remotesWithoutUUID remotes (map toUUID preverified'++untrusteduuids) u <- getUUID - ifM (canDrop u key afile numcopies [] preverified' tocheck) + doDrop u key afile numcopies [] preverified' tocheck ( do removeAnnex contentlock notifyDrop afile True next $ cleanupLocal key - , do + , do notifyDrop afile False stop ) @@ -121,9 +121,12 @@ performRemote key afile numcopies remote = do untrusteduuids <- trustGet UnTrusted let tocheck = filter (/= remote) $ Remote.remotesWithoutUUID remotes (trusted++untrusteduuids) - stopUnless (canDrop uuid key afile numcopies [uuid] preverified tocheck) $ do - ok <- Remote.removeKey remote key - next $ cleanupRemote key remote ok + doDrop uuid key afile numcopies [uuid] preverified tocheck + ( do + ok <- Remote.removeKey remote key + next $ cleanupRemote key remote ok + , stop + ) where uuid = Remote.uuid remote @@ -138,29 +141,29 @@ cleanupRemote key remote ok = do Remote.logStatus remote key InfoMissing return ok -{- Checks specified remotes to verify that enough copies of a key exist to - - allow it to be safely removed (with no data loss). +{- Before running the dropaction, checks specified remotes to + - 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. -} -canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [VerifiedCopy] -> [Remote] -> Annex Bool -canDrop dropfrom key afile numcopies skip preverified check = +doDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [VerifiedCopy] -> [Remote] -> (CommandPerform, CommandPerform) -> CommandPerform +doDrop dropfrom key afile numcopies skip preverified check (dropaction, nodropaction) = ifM (Annex.getState Annex.force) - ( return True - , ifM (checkRequiredContent dropfrom key afile - <&&> verifyEnoughCopies nolocmsg key numcopies skip preverified check - ) - ( return True - , do - hint - return False - ) + ( dropaction + , ifM (checkRequiredContent dropfrom key afile) + ( verifyEnoughCopiesToDrop nolocmsg key numcopies + skip preverified check (const dropaction) (forcehint nodropaction) + , stop + ) ) where nolocmsg = "Rather than dropping this file, try using: git annex move" - hint = showLongNote "(Use --force to override this check, or adjust numcopies.)" + forcehint a = do + showLongNote "(Use --force to override this check, or adjust numcopies.)" + a checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool checkRequiredContent u k afile = diff --git a/Command/Import.hs b/Command/Import.hs index 3206ad48b..f486da7c5 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -83,7 +83,7 @@ start mode (srcfile, destfile) = where deletedup k = do showNote $ "duplicate of " ++ key2file k - ifM (verifiedExisting k destfile) + verifyExisting k destfile ( do liftIO $ removeFile srcfile next $ return True @@ -134,8 +134,8 @@ start mode (srcfile, destfile) = SkipDuplicates -> checkdup Nothing (Just importfile) _ -> return (Just importfile) -verifiedExisting :: Key -> FilePath -> Annex Bool -verifiedExisting key destfile = do +verifyExisting :: Key -> FilePath -> (CommandPerform, CommandPerform) -> CommandPerform +verifyExisting key destfile (yes, no) = do -- Look up the numcopies setting for the file that it would be -- imported to, if it were imported. need <- getFileNumCopies destfile @@ -143,4 +143,6 @@ verifiedExisting key destfile = do (remotes, trusteduuids) <- knownCopies key untrusteduuids <- trustGet UnTrusted let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids) - verifyEnoughCopies [] key need [] (map (mkVerifiedCopy TrustedCopy) trusteduuids) tocheck + let preverified = map (mkVerifiedCopy TrustedCopy) trusteduuids + verifyEnoughCopiesToDrop [] key need [] preverified tocheck + (const yes) no diff --git a/Types/NumCopies.hs b/Types/NumCopies.hs index 38bce6818..23df6610a 100644 --- a/Types/NumCopies.hs +++ b/Types/NumCopies.hs @@ -16,6 +16,9 @@ module Types.NumCopies ( mkVerifiedCopy, invalidatableVerifiedCopy, withVerifiedCopy, + isSafeDrop, + SafeDropProof, + mkSafeDropProof, ) where import Types.UUID @@ -25,6 +28,7 @@ import qualified Data.Map as M import Control.Concurrent.MVar import Control.Monad.Catch (MonadMask) import Control.Monad.IO.Class (MonadIO) +import Control.Monad newtype NumCopies = NumCopies Int deriving (Ord, Eq) @@ -108,3 +112,38 @@ withVerifiedCopy mk u = bracketIO setup cleanup where setup = invalidatableVerifiedCopy mk u cleanup = invalidateVerifiedCopy + +{- Check whether enough verification has been done of copies to allow + - dropping content safely. + - + - Unless numcopies is 0, at least one VerifiedCopyLock or TrustedCopy + - is required. A VerifiedCopyLock prevents races between concurrent + - drops from dropping the last copy, no matter what. + - + - The other N-1 copies can be less strong verifications, like + - RecentlyVerifiedCopy. While those are subject to concurrent drop races, + - and so could be dropped all at once, causing numcopies to be violated, + - this is the best that can be done without requiring all special remotes + - to support locking. + -} +isSafeDrop :: NumCopies -> [VerifiedCopy] -> Bool +isSafeDrop (NumCopies n) l + | n == 0 = True + | otherwise = length (deDupVerifiedCopies l) >= n && any fullVerification l + +fullVerification :: VerifiedCopy -> Bool +fullVerification (VerifiedCopyLock _) = True +fullVerification (TrustedCopy _) = True +fullVerification (RecentlyVerifiedCopy _) = False + +-- A proof that it's currently safe to drop an object. +data SafeDropProof = SafeDropProof NumCopies [VerifiedCopy] + +-- Make sure that none of the VerifiedCopies have become invalidated +-- before constructing proof. +mkSafeDropProof :: NumCopies -> [VerifiedCopy] -> IO (Either [VerifiedCopy] SafeDropProof) +mkSafeDropProof need have = do + stillhave <- filterM checkVerifiedCopy have + return $ if isSafeDrop need stillhave + then Right (SafeDropProof need stillhave) + else Left stillhave diff --git a/debian/changelog b/debian/changelog index f3ffa5975..bd503b55e 100644 --- a/debian/changelog +++ b/debian/changelog @@ -20,9 +20,16 @@ git-annex (5.20150931) UNRELEASED; urgency=medium and stop recommending bittornado | bittorrent. * Debian: Remove dependency on transformers library, as it is now included in ghc. + * Fix a longstanding bug, where dropping a file from a remote + could race with other drops of the same file, and result in + all copies of its content being lost. * git-annex-shell: Added lockcontent command, to prevent dropping of - key's content. - + a key's content. This is necessary due to the above bugfix. + * When a remote uses an old version of git-annex-shell without the + new lockcontent command, git-annex may not trust the remote enough + to be able to drop content. + Solution: Upgrade git-annex-shell to this version. + -- Joey Hess <id@joeyh.name> Thu, 01 Oct 2015 12:42:56 -0400 git-annex (5.20150930) unstable; urgency=medium |