From 6a720457070305cd82a34ffe52c7a3379591b24f Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 9 Oct 2015 15:48:02 -0400 Subject: [PATCH] fix local dropping to not require extra locking of copies, but only that the local copy be locked for removal --- Annex/Content.hs | 15 ++++++------ Annex/NumCopies.hs | 13 ++++++----- Assistant/Unused.hs | 2 +- Assistant/Upgrade.hs | 2 +- Command/Drop.hs | 16 ++++++------- Command/DropKey.hs | 2 +- Command/Import.hs | 2 +- Command/Move.hs | 2 +- Command/TestRemote.hs | 10 ++++---- Command/Uninit.hs | 2 +- Remote/Git.hs | 2 +- Types/NumCopies.hs | 54 ++++++++++++++++++++++++++++++++----------- 12 files changed, 73 insertions(+), 49 deletions(-) diff --git a/Annex/Content.hs b/Annex/Content.hs index 40c78fd340..0dc47d9e29 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -13,7 +13,8 @@ module Annex.Content ( inAnnexSafe, inAnnexCheck, lockContentShared, - lockContentExclusive, + lockContentForRemoval, + ContentRemovalLock, getViaTmp, getViaTmp', checkDiskSpaceToGet, @@ -192,14 +193,12 @@ lockContentShared key a = lockContentUsing lock key $ do lock = winLocker lockShared #endif -newtype ContentLockExclusive = ContentLockExclusive Key - {- Exclusively locks content, while performing an action that - might remove it. -} -lockContentExclusive :: Key -> (ContentLockExclusive -> Annex a) -> Annex a -lockContentExclusive key a = lockContentUsing lock key $ - a (ContentLockExclusive key) +lockContentForRemoval :: Key -> (ContentRemovalLock -> Annex a) -> Annex a +lockContentForRemoval key a = lockContentUsing lock key $ + a (ContentRemovalLock key) where #ifndef mingw32_HOST_OS {- Since content files are stored with the write bit disabled, have @@ -547,8 +546,8 @@ cleanObjectLoc key cleaner = do - In direct mode, deletes the associated files or files, and replaces - them with symlinks. -} -removeAnnex :: ContentLockExclusive -> Annex () -removeAnnex (ContentLockExclusive key) = withObjectLoc key remove removedirect +removeAnnex :: ContentRemovalLock -> Annex () +removeAnnex (ContentRemovalLock key) = withObjectLoc key remove removedirect where remove file = cleanObjectLoc key $ do secureErase file diff --git a/Annex/NumCopies.hs b/Annex/NumCopies.hs index b51d3815b2..2ddb460fd8 100644 --- a/Annex/NumCopies.hs +++ b/Annex/NumCopies.hs @@ -104,12 +104,13 @@ data UnVerifiedCopy = UnVerifiedRemote Remote | UnVerifiedHere deriving (Ord, Eq) {- Verifies that enough copies of a key exist amoung the listed remotes, - - running an action with a proof if so, and printing an informative - - message if not. + - to safely drop it, running an action with a proof if so, and + - printing an informative message if not. -} verifyEnoughCopiesToDrop :: String -- message to print when there are no known locations -> Key + -> Maybe ContentRemovalLock -> NumCopies -> [UUID] -- repos to skip considering (generally untrusted remotes) -> [VerifiedCopy] -- copies already verified to exist @@ -117,19 +118,19 @@ verifyEnoughCopiesToDrop -> (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 = +verifyEnoughCopiesToDrop nolocmsg key removallock need skip preverified tocheck dropaction nodropaction = helper [] [] preverified (nub tocheck) where helper bad missing have [] = do - p <- liftIO $ mkSafeDropProof need have + p <- liftIO $ mkSafeDropProof need have removallock case p of Right proof -> dropaction proof Left stillhave -> do notEnoughCopies key need stillhave (skip++missing) bad nolocmsg nodropaction helper bad missing have (c:cs) - | isSafeDrop need have = do - p <- liftIO $ mkSafeDropProof need have + | isSafeDrop need have removallock = do + p <- liftIO $ mkSafeDropProof need have removallock case p of Right proof -> dropaction proof Left stillhave -> helper bad missing stillhave (c:cs) diff --git a/Assistant/Unused.hs b/Assistant/Unused.hs index c71604679d..55a04c597a 100644 --- a/Assistant/Unused.hs +++ b/Assistant/Unused.hs @@ -77,7 +77,7 @@ expireUnused duration = do forM_ oldkeys $ \k -> do debug ["removing old unused key", key2file k] liftAnnex $ do - lockContentExclusive k removeAnnex + lockContentForRemoval k removeAnnex logStatus k InfoMissing where boundry = durationToPOSIXTime <$> duration diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs index 88ef5bed15..177603338f 100644 --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -97,7 +97,7 @@ startDistributionDownload d = go =<< liftIO . newVersionLocation d =<< liftIO ol , transferKey = k } cleanup = liftAnnex $ do - lockContentExclusive k removeAnnex + lockContentForRemoval k removeAnnex setUrlMissing webUUID k u logStatus k InfoMissing diff --git a/Command/Drop.hs b/Command/Drop.hs index a2bca22044..d14cdad18e 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -91,15 +91,11 @@ startRemote afile numcopies key remote = do showStart' ("drop " ++ Remote.name remote) key afile next $ performRemote key afile numcopies remote --- Note that lockContentExclusive is called before checking if the key is --- present on enough remotes to allow removal. This avoids a scenario where two --- or more remotes are trying to remove a key at the same time, and each --- sees the key is present on the other. performLocal :: Key -> AssociatedFile -> NumCopies -> [VerifiedCopy] -> CommandPerform -performLocal key afile numcopies preverified = lockContentExclusive key $ \contentlock -> do +performLocal key afile numcopies preverified = lockContentForRemoval key $ \contentlock -> do u <- getUUID (tocheck, verified) <- verifiableCopies key [u] - doDrop u key afile numcopies [] (preverified ++ verified) tocheck + doDrop u (Just contentlock) key afile numcopies [] (preverified ++ verified) tocheck ( \proof -> do liftIO $ debugM "drop" $ unwords [ "Dropping from here" @@ -121,7 +117,7 @@ performRemote key afile numcopies remote = do -- When the local repo has the key, that's one additional copy, -- as long as the local repo is not untrusted. (tocheck, verified) <- verifiableCopies key [uuid] - doDrop uuid key afile numcopies [uuid] verified tocheck + doDrop uuid Nothing key afile numcopies [uuid] verified tocheck ( \proof -> do liftIO $ debugM "drop" $ unwords [ "Dropping from remote" @@ -159,6 +155,7 @@ cleanupRemote key remote ok = do -} doDrop :: UUID + -> Maybe ContentRemovalLock -> Key -> AssociatedFile -> NumCopies @@ -167,11 +164,12 @@ doDrop -> [UnVerifiedCopy] -> (Maybe SafeDropProof -> CommandPerform, CommandPerform) -> CommandPerform -doDrop dropfrom key afile numcopies skip preverified check (dropaction, nodropaction) = +doDrop dropfrom contentlock key afile numcopies skip preverified check (dropaction, nodropaction) = ifM (Annex.getState Annex.force) ( dropaction Nothing , ifM (checkRequiredContent dropfrom key afile) - ( verifyEnoughCopiesToDrop nolocmsg key numcopies + ( verifyEnoughCopiesToDrop nolocmsg key + contentlock numcopies skip preverified check (dropaction . Just) (forcehint nodropaction) diff --git a/Command/DropKey.hs b/Command/DropKey.hs index cdb19cabb3..3dea4b4b79 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -31,7 +31,7 @@ start key = stopUnless (inAnnex key) $ do next $ perform key perform :: Key -> CommandPerform -perform key = lockContentExclusive key $ \contentlock -> do +perform key = lockContentForRemoval key $ \contentlock -> do removeAnnex contentlock next $ cleanup key diff --git a/Command/Import.hs b/Command/Import.hs index 5ac050351c..a96c080556 100644 --- a/Command/Import.hs +++ b/Command/Import.hs @@ -139,5 +139,5 @@ verifyExisting key destfile (yes, no) = do need <- getFileNumCopies destfile (tocheck, preverified) <- verifiableCopies key [] - verifyEnoughCopiesToDrop [] key need [] preverified tocheck + verifyEnoughCopiesToDrop [] key Nothing need [] preverified tocheck (const yes) no diff --git a/Command/Move.hs b/Command/Move.hs index 072c00663b..bd1b6dd927 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -123,7 +123,7 @@ toPerform dest move key afile fastcheck isthere = finish where finish - | move = lockContentExclusive key $ \contentlock -> do + | move = lockContentForRemoval key $ \contentlock -> do removeAnnex contentlock next $ Command.Drop.cleanupLocal key | otherwise = next $ return True diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index 3a44a1bde2..be1b9a3243 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -120,7 +120,7 @@ test st r k = , check "storeKey when already present" store , present True , check "retrieveKeyFile" $ do - lockContentExclusive k removeAnnex + lockContentForRemoval k removeAnnex get , check "fsck downloaded object" fsck , check "retrieveKeyFile resume from 33%" $ do @@ -130,20 +130,20 @@ test st r k = sz <- hFileSize h L.hGet h $ fromInteger $ sz `div` 3 liftIO $ L.writeFile tmp partial - lockContentExclusive k removeAnnex + lockContentForRemoval k removeAnnex get , check "fsck downloaded object" fsck , check "retrieveKeyFile resume from 0" $ do tmp <- prepTmp k liftIO $ writeFile tmp "" - lockContentExclusive k removeAnnex + lockContentForRemoval k removeAnnex get , check "fsck downloaded object" fsck , check "retrieveKeyFile resume from end" $ do loc <- Annex.calcRepo (gitAnnexLocation k) tmp <- prepTmp k void $ liftIO $ copyFileExternal CopyAllMetaData loc tmp - lockContentExclusive k removeAnnex + lockContentForRemoval k removeAnnex get , check "fsck downloaded object" fsck , check "removeKey when present" remove @@ -189,7 +189,7 @@ testUnavailable st r k = cleanup :: [Remote] -> [Key] -> Bool -> CommandCleanup cleanup rs ks ok = do forM_ rs $ \r -> forM_ ks (Remote.removeKey r) - forM_ ks $ \k -> lockContentExclusive k removeAnnex + forM_ ks $ \k -> lockContentForRemoval k removeAnnex return ok chunkSizes :: Int -> Bool -> [Int] diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 38e0620025..cc237db5e9 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -105,7 +105,7 @@ removeUnannexed = go [] go c [] = return c go c (k:ks) = ifM (inAnnexCheck k $ liftIO . enoughlinks) ( do - lockContentExclusive k removeAnnex + lockContentForRemoval k removeAnnex go c ks , go (k:c) ks ) diff --git a/Remote/Git.hs b/Remote/Git.hs index 5c429c93c9..a6c4315ab4 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -352,7 +352,7 @@ dropKey r key commitOnCleanup r $ onLocal r $ do ensureInitialized whenM (Annex.Content.inAnnex key) $ do - Annex.Content.lockContentExclusive key + Annex.Content.lockContentForRemoval key Annex.Content.removeAnnex logStatus key InfoMissing Annex.Content.saveState True diff --git a/Types/NumCopies.hs b/Types/NumCopies.hs index bbd1b38313..60e0db5809 100644 --- a/Types/NumCopies.hs +++ b/Types/NumCopies.hs @@ -19,9 +19,11 @@ module Types.NumCopies ( isSafeDrop, SafeDropProof, mkSafeDropProof, + ContentRemovalLock(..), ) where import Types.UUID +import Types.Key import Utility.Exception (bracketIO) import qualified Data.Map as M @@ -36,6 +38,11 @@ newtype NumCopies = NumCopies Int fromNumCopies :: NumCopies -> Int fromNumCopies (NumCopies n) = n +-- Indicates that a key's content is exclusively +-- locked locally, pending removal. +newtype ContentRemovalLock = ContentRemovalLock Key + deriving (Show) + -- A verification that a copy of a key exists in a repository. data VerifiedCopy {- Represents a recent verification that a copy of an @@ -48,7 +55,7 @@ data VerifiedCopy {- The strongest proof of the existence of a copy. - Until its associated action is called to unlock it, - the copy is locked in the repository and is guaranteed - - not to be dropped by any git-annex process. -} + - not to be removed by any git-annex process. -} | LockedCopy V deriving (Show) @@ -116,20 +123,39 @@ withVerifiedCopy mk u = bracketIO setup cleanup {- Check whether enough verification has been done of copies to allow - dropping content safely. - - - Unless numcopies is 0, at least one LockedCopy or TrustedCopy - - is required. A LockedCopy prevents races between concurrent - - drops from dropping the last copy, no matter what. + - This is carefully balanced to prevent data loss when there are races + - between concurrent drops of the same content in different repos, + - without requiring impractical amounts of locking. + - + - In particular, concurrent drop races may cause the number of copies + - to fall below NumCopies, but it will never fall below 1. + -} +isSafeDrop :: NumCopies -> [VerifiedCopy] -> Maybe ContentRemovalLock -> Bool +{- When a ContentRemovalLock is provided, the content is being + - dropped from the local repo. That lock will prevent other git repos + - that are concurrently dropping from using the local copy as a VerifiedCopy. + - So, no additional locking is needed; all we need is verifications + - of any kind of N other copies of the content. -} +isSafeDrop (NumCopies n) l (Just (ContentRemovalLock _)) = + length (deDupVerifiedCopies l) >= n +{- Dropping from a remote repo. + - + - Unless numcopies is 0, at least one LockedCopy or TrustedCopy is required. + - A LockedCopy 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. + - this is the best that can be done without requiring that + - all special remotes support locking. -} -isSafeDrop :: NumCopies -> [VerifiedCopy] -> Bool -isSafeDrop (NumCopies n) l +isSafeDrop (NumCopies n) l Nothing | n == 0 = True - | otherwise = length (deDupVerifiedCopies l) >= n && any fullVerification l + | otherwise = and + [ length (deDupVerifiedCopies l) >= n + , any fullVerification l + ] fullVerification :: VerifiedCopy -> Bool fullVerification (LockedCopy _) = True @@ -137,14 +163,14 @@ fullVerification (TrustedCopy _) = True fullVerification (RecentlyVerifiedCopy _) = False -- A proof that it's currently safe to drop an object. -data SafeDropProof = SafeDropProof NumCopies [VerifiedCopy] +data SafeDropProof = SafeDropProof NumCopies [VerifiedCopy] (Maybe ContentRemovalLock) deriving (Show) -- Make sure that none of the VerifiedCopies have become invalidated -- before constructing proof. -mkSafeDropProof :: NumCopies -> [VerifiedCopy] -> IO (Either [VerifiedCopy] SafeDropProof) -mkSafeDropProof need have = do +mkSafeDropProof :: NumCopies -> [VerifiedCopy] -> Maybe ContentRemovalLock -> IO (Either [VerifiedCopy] SafeDropProof) +mkSafeDropProof need have removallock = do stillhave <- filterM checkVerifiedCopy have - return $ if isSafeDrop need stillhave - then Right (SafeDropProof need stillhave) + return $ if isSafeDrop need stillhave removallock + then Right (SafeDropProof need stillhave removallock) else Left stillhave