diff options
| -rw-r--r-- | Annex/Content.hs | 19 | ||||
| -rw-r--r-- | Assistant/Unused.hs | 2 | ||||
| -rw-r--r-- | Command/Drop.hs | 10 | ||||
| -rw-r--r-- | Command/DropKey.hs | 4 | ||||
| -rw-r--r-- | Command/Move.hs | 13 | ||||
| -rw-r--r-- | Command/TestRemote.hs | 10 | ||||
| -rw-r--r-- | Command/Uninit.hs | 2 | ||||
| -rw-r--r-- | Remote/Git.hs | 4 |
8 files changed, 34 insertions, 30 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs index 90ab7db58..86b78c04e 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 3ad98c12e..c2c10b048 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/Command/Drop.hs b/Command/Drop.hs index 4bac07a53..cf63d2bc7 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 125e6ded4..8ca41bdb6 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 f70608a6f..c3d641edd 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 3e1933d21..1cb1929e0 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 4433de6d0..3f57782fc 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 db5b2fbd0..bf796ec11 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 |