reorg to allow taking content lock
The lock will only persist during the perform stage, so the content must be removed from the annex then, rather than in the cleanup stage. (No lock is actually taken yet.)
This commit is contained in:
parent
58563c5b1a
commit
8ce7e73f74
5 changed files with 54 additions and 26 deletions
|
@ -7,6 +7,8 @@
|
|||
|
||||
module Annex.Content (
|
||||
inAnnex,
|
||||
lockExclusive,
|
||||
lockShared,
|
||||
calcGitLink,
|
||||
logStatus,
|
||||
getViaTmp,
|
||||
|
@ -41,6 +43,16 @@ inAnnex key = do
|
|||
error "inAnnex cannot check remote repo"
|
||||
inRepo $ doesFileExist . gitAnnexLocation key
|
||||
|
||||
{- Content is exclusively locked to indicate that it's in the process of
|
||||
- being removed. -}
|
||||
lockExclusive :: Key -> Annex a -> Annex a
|
||||
lockExclusive key a = a -- TODO
|
||||
|
||||
{- Things that rely on content being present can take a shared lock to
|
||||
- avoid it vanishing from under them. -}
|
||||
lockShared :: Key -> Annex a -> Annex a
|
||||
lockShared key a = a -- TODO
|
||||
|
||||
{- Calculates the relative path to use to link a file to a key. -}
|
||||
calcGitLink :: FilePath -> Key -> Annex FilePath
|
||||
calcGitLink file key = do
|
||||
|
|
|
@ -52,17 +52,19 @@ startRemote file numcopies key remote = do
|
|||
next $ performRemote key numcopies remote
|
||||
|
||||
performLocal :: Key -> Maybe Int -> CommandPerform
|
||||
performLocal key numcopies = do
|
||||
performLocal key numcopies = lockExclusive key $ do
|
||||
(remotes, trusteduuids) <- Remote.keyPossibilitiesTrusted key
|
||||
untrusteduuids <- trustGet UnTrusted
|
||||
let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
|
||||
success <- canDropKey key numcopies trusteduuids tocheck []
|
||||
if success
|
||||
then next $ cleanupLocal key
|
||||
then do
|
||||
whenM (inAnnex key) $ removeAnnex key
|
||||
next $ cleanupLocal key
|
||||
else stop
|
||||
|
||||
performRemote :: Key -> Maybe Int -> Remote.Remote Annex -> CommandPerform
|
||||
performRemote key numcopies remote = do
|
||||
performRemote key numcopies remote = lockExclusive key $ 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.
|
||||
|
@ -76,20 +78,20 @@ performRemote key numcopies remote = do
|
|||
Remote.remotesWithoutUUID remotes (have++untrusteduuids)
|
||||
success <- canDropKey key numcopies have tocheck [uuid]
|
||||
if success
|
||||
then next $ cleanupRemote key remote
|
||||
then do
|
||||
ok <- Remote.removeKey remote key
|
||||
next $ cleanupRemote key remote ok
|
||||
else stop
|
||||
where
|
||||
uuid = Remote.uuid remote
|
||||
|
||||
cleanupLocal :: Key -> CommandCleanup
|
||||
cleanupLocal key = do
|
||||
whenM (inAnnex key) $ removeAnnex key
|
||||
logStatus key InfoMissing
|
||||
return True
|
||||
|
||||
cleanupRemote :: Key -> Remote.Remote Annex -> CommandCleanup
|
||||
cleanupRemote key remote = do
|
||||
ok <- Remote.removeKey remote key
|
||||
cleanupRemote :: Key -> Remote.Remote Annex -> Bool -> CommandCleanup
|
||||
cleanupRemote key remote ok = do
|
||||
-- better safe than sorry: assume the remote dropped the key
|
||||
-- even if it seemed to fail; the failure could have occurred
|
||||
-- after it really dropped it
|
||||
|
|
|
@ -55,7 +55,8 @@ perform key = maybe droplocal dropremote =<< Annex.getState Annex.fromremote
|
|||
dropremote name = do
|
||||
r <- Remote.byName name
|
||||
showAction $ "from " ++ Remote.name r
|
||||
next $ Command.Drop.cleanupRemote key r
|
||||
ok <- Remote.removeKey r key
|
||||
next $ Command.Drop.cleanupRemote key r ok
|
||||
droplocal = Command.Drop.performLocal key (Just 0) -- force drop
|
||||
|
||||
performOther :: (Key -> Git.Repo -> FilePath) -> Key -> CommandPerform
|
||||
|
|
|
@ -68,7 +68,7 @@ toStart dest move file = isAnnexed file $ \(key, _) -> do
|
|||
showMoveAction move file
|
||||
next $ toPerform dest move key
|
||||
toPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform
|
||||
toPerform dest move key = do
|
||||
toPerform dest move key = moveLock move key $ do
|
||||
-- Checking the remote is expensive, so not done in the start step.
|
||||
-- In fast mode, location tracking is assumed to be correct,
|
||||
-- and an explicit check is not done, when copying. When moving,
|
||||
|
@ -88,18 +88,20 @@ toPerform dest move key = do
|
|||
showAction $ "to " ++ Remote.name dest
|
||||
ok <- Remote.storeKey dest key
|
||||
if ok
|
||||
then next $ toCleanup dest move key
|
||||
then finish
|
||||
else do
|
||||
when fastcheck $
|
||||
warning "This could have failed because --fast is enabled."
|
||||
stop
|
||||
Right True -> next $ toCleanup dest move key
|
||||
toCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup
|
||||
toCleanup dest move key = do
|
||||
Remote.remoteHasKey dest key True
|
||||
if move
|
||||
then Command.Drop.cleanupLocal key
|
||||
else return True
|
||||
Right True -> finish
|
||||
where
|
||||
finish = do
|
||||
Remote.remoteHasKey dest key True
|
||||
if move
|
||||
then do
|
||||
whenM (inAnnex key) $ removeAnnex key
|
||||
next $ Command.Drop.cleanupLocal key
|
||||
else next $ return True
|
||||
|
||||
{- Moves (or copies) the content of an annexed file from a remote
|
||||
- to the current repository.
|
||||
|
@ -117,16 +119,23 @@ fromStart src move file = isAnnexed file $ \(key, _) -> do
|
|||
showMoveAction move file
|
||||
next $ fromPerform src move key
|
||||
fromPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform
|
||||
fromPerform src move key = do
|
||||
fromPerform src move key = moveLock move key $ do
|
||||
ishere <- inAnnex key
|
||||
if ishere
|
||||
then next $ fromCleanup src move key
|
||||
then handle move True
|
||||
else do
|
||||
showAction $ "from " ++ Remote.name src
|
||||
ok <- getViaTmp key $ Remote.retrieveKeyFile src key
|
||||
if ok
|
||||
then next $ fromCleanup src move key
|
||||
else stop -- fail
|
||||
fromCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup
|
||||
fromCleanup src True key = Command.Drop.cleanupRemote key src
|
||||
fromCleanup _ False _ = return True
|
||||
handle move ok
|
||||
where
|
||||
handle _ False = stop -- failed
|
||||
handle False True = next $ return True -- copy complete
|
||||
handle 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.
|
||||
- No lock is needed when a key is being copied. -}
|
||||
moveLock :: Bool -> Key -> Annex a -> Annex a
|
||||
moveLock True key a = lockExclusive key a
|
||||
moveLock False _ a = a
|
||||
|
|
|
@ -38,6 +38,10 @@ distinguishable from "not in annex".
|
|||
|
||||
---
|
||||
|
||||
drop --from could also cycle. Locking should fix.
|
||||
|
||||
---
|
||||
|
||||
move --to can also be included in the cycle, since it can drop data.
|
||||
|
||||
Consider move to a remote that already has the content and
|
||||
|
|
Loading…
Reference in a new issue