From aebcc395ffec212d9eb9a343748b4d409f5e667a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 20 Aug 2014 20:08:45 -0400 Subject: [PATCH] use types to enforce that removeAnnex can only be called inside lockContent This fixed one bug where it needed to be and wasn't (in Assistant.Unused). And also found one place where lockContent was used unnecessarily (by drop --from remote). A few other places like uninit probably don't really need to lockContent, but it doesn't hurt to do call it anyway. This commit was sponsored by David Wagner. --- Annex/Content.hs | 19 +++++++++++++------ Assistant/Unused.hs | 2 +- Assistant/Upgrade.hs | 2 +- Command/Drop.hs | 10 +++++++--- Command/DropKey.hs | 4 ++-- Command/Move.hs | 13 +++---------- Command/TestRemote.hs | 10 +++++----- Command/Uninit.hs | 2 +- Remote/Git.hs | 4 ++-- 9 files changed, 35 insertions(+), 31 deletions(-) diff --git a/Annex/Content.hs b/Annex/Content.hs index 90ab7db585..86b78c04e0 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -152,14 +152,20 @@ contentLockFile key = ifM isDirect , return Nothing ) +newtype ContentLock = ContentLock Key + {- Content is exclusively locked while running an action that might remove - - it. (If the content is not present, no locking is done.) -} -lockContent :: Key -> Annex a -> Annex a + - it. (If the content is not present, no locking is done.) + -} +lockContent :: Key -> (ContentLock -> Annex a) -> Annex a lockContent key a = do contentfile <- calcRepo $ gitAnnexLocation key lockfile <- contentLockFile key maybe noop setuplockfile lockfile - bracket (lock contentfile lockfile) (unlock lockfile) (const a) + bracket + (lock contentfile lockfile) + (unlock lockfile) + (const $ a $ ContentLock key) where alreadylocked = error "content is locked" setuplockfile lockfile = modifyContent lockfile $ @@ -426,9 +432,10 @@ cleanObjectLoc key cleaner = do {- Removes a key's file from .git/annex/objects/ - - In direct mode, deletes the associated files or files, and replaces - - them with symlinks. -} -removeAnnex :: Key -> Annex () -removeAnnex key = withObjectLoc key remove removedirect + - them with symlinks. + -} +removeAnnex :: ContentLock -> Annex () +removeAnnex (ContentLock key) = withObjectLoc key remove removedirect where remove file = cleanObjectLoc key $ do secureErase file diff --git a/Assistant/Unused.hs b/Assistant/Unused.hs index 3ad98c12e2..c2c10b048b 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 - removeAnnex k + lockContent k removeAnnex logStatus k InfoMissing where boundry = durationToPOSIXTime <$> duration diff --git a/Assistant/Upgrade.hs b/Assistant/Upgrade.hs index 1456f8e5ac..b847068c29 100644 --- a/Assistant/Upgrade.hs +++ b/Assistant/Upgrade.hs @@ -96,7 +96,7 @@ startDistributionDownload d = go =<< liftIO . newVersionLocation d =<< liftIO ol , transferKey = k } cleanup = liftAnnex $ do - removeAnnex k + lockContent k removeAnnex setUrlMissing k u logStatus k InfoMissing diff --git a/Command/Drop.hs b/Command/Drop.hs index 4bac07a533..cf63d2bc7e 100644 --- a/Command/Drop.hs +++ b/Command/Drop.hs @@ -55,8 +55,12 @@ startRemote afile numcopies key remote = do showStart' ("drop " ++ Remote.name remote) key afile next $ performRemote key afile numcopies remote +-- Note that lockContent 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 +-- see the key is present on the other. performLocal :: Key -> AssociatedFile -> NumCopies -> Maybe Remote -> CommandPerform -performLocal key afile numcopies knownpresentremote = lockContent key $ do +performLocal key afile numcopies knownpresentremote = lockContent key $ \contentlock -> do (remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key let trusteduuids' = case knownpresentremote of Nothing -> trusteduuids @@ -66,7 +70,7 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ do u <- getUUID ifM (canDrop u key afile numcopies trusteduuids' tocheck []) ( do - removeAnnex key + removeAnnex contentlock notifyDrop afile True next $ cleanupLocal key , do @@ -75,7 +79,7 @@ performLocal key afile numcopies knownpresentremote = lockContent key $ do ) performRemote :: Key -> AssociatedFile -> NumCopies -> Remote -> CommandPerform -performRemote key afile numcopies remote = lockContent key $ do +performRemote key afile numcopies remote = do -- Filter the remote it's being dropped from out of the lists of -- places assumed to have the key, and places to check. -- When the local repo has the key, that's one additional copy, diff --git a/Command/DropKey.hs b/Command/DropKey.hs index 125e6ded40..8ca41bdb6c 100644 --- a/Command/DropKey.hs +++ b/Command/DropKey.hs @@ -28,8 +28,8 @@ start key = stopUnless (inAnnex key) $ do next $ perform key perform :: Key -> CommandPerform -perform key = lockContent key $ do - removeAnnex key +perform key = lockContent key $ \contentlock -> do + removeAnnex contentlock next $ cleanup key cleanup :: Key -> CommandCleanup diff --git a/Command/Move.hs b/Command/Move.hs index f70608a6f7..c3d641edd5 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -91,7 +91,7 @@ expectedPresent dest key = do return $ dest `elem` remotes toPerform :: Remote -> Bool -> Key -> AssociatedFile -> Bool -> Either String Bool -> CommandPerform -toPerform dest move key afile fastcheck isthere = moveLock move key $ +toPerform dest move key afile fastcheck isthere = do case isthere of Left err -> do showNote err @@ -115,8 +115,8 @@ toPerform dest move key afile fastcheck isthere = moveLock move key $ finish where finish - | move = do - removeAnnex key + | move = lockContent key $ \contentlock -> do + removeAnnex contentlock next $ Command.Drop.cleanupLocal key | otherwise = next $ return True @@ -164,10 +164,3 @@ fromPerform src move key afile = ifM (inAnnex key) dispatch True True = do -- finish moving ok <- Remote.removeKey src key next $ Command.Drop.cleanupRemote key src ok - -{- Locks a key in order for it to be moved away from the current repository. - - No lock is needed when a key is being copied, or moved to the current - - repository. -} -moveLock :: Bool -> Key -> Annex a -> Annex a -moveLock True key a = lockContent key a -moveLock False _ a = a diff --git a/Command/TestRemote.hs b/Command/TestRemote.hs index 3e1933d219..1cb1929e01 100644 --- a/Command/TestRemote.hs +++ b/Command/TestRemote.hs @@ -114,7 +114,7 @@ test st r k = , check "storeKey when already present" store , present True , check "retrieveKeyFile" $ do - removeAnnex k + lockContent k removeAnnex get , check "fsck downloaded object" fsck , check "retrieveKeyFile resume from 33%" $ do @@ -124,20 +124,20 @@ test st r k = sz <- hFileSize h L.hGet h $ fromInteger $ sz `div` 3 liftIO $ L.writeFile tmp partial - removeAnnex k + lockContent k removeAnnex get , check "fsck downloaded object" fsck , check "retrieveKeyFile resume from 0" $ do tmp <- prepTmp k liftIO $ writeFile tmp "" - removeAnnex k + lockContent 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 loc tmp - removeAnnex k + lockContent k removeAnnex get , check "fsck downloaded object" fsck , check "removeKey when present" remove @@ -183,7 +183,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 removeAnnex + forM_ ks $ \k -> lockContent k removeAnnex return ok chunkSizes :: Int -> Bool -> [Int] diff --git a/Command/Uninit.hs b/Command/Uninit.hs index 4433de6d01..3f57782fce 100644 --- a/Command/Uninit.hs +++ b/Command/Uninit.hs @@ -103,7 +103,7 @@ removeUnannexed = go [] go c [] = return c go c (k:ks) = ifM (inAnnexCheck k $ liftIO . enoughlinks) ( do - removeAnnex k + lockContent k removeAnnex go c ks , go (k:c) ks ) diff --git a/Remote/Git.hs b/Remote/Git.hs index db5b2fbd0a..bf796ec117 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -339,8 +339,8 @@ dropKey r key commitOnCleanup r $ onLocal r $ do ensureInitialized whenM (Annex.Content.inAnnex key) $ do - Annex.Content.lockContent key $ - Annex.Content.removeAnnex key + Annex.Content.lockContent key + Annex.Content.removeAnnex logStatus key InfoMissing Annex.Content.saveState True return True