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.
This commit is contained in:
parent
9cb78e18ad
commit
aebcc395ff
9 changed files with 35 additions and 31 deletions
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue