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:
Joey Hess 2011-11-09 16:54:18 -04:00
parent 58563c5b1a
commit 8ce7e73f74
5 changed files with 54 additions and 26 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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